arpack-ng-3.1.5/ 0000755 0001750 0001750 00000000000 12277671743 010404 5 0000000 0000000 arpack-ng-3.1.5/SRC/ 0000755 0001750 0001750 00000000000 12277671743 011033 5 0000000 0000000 arpack-ng-3.1.5/SRC/dngets.f 0000644 0001750 0001750 00000017534 12277373057 012415 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dngets
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call dngets
c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortc ARPACK sorting routine.
c dcopy Level 1 BLAS that copies one vector to another .
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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dngets ( ishift, which, kev, np, ritzr, ritzi, bounds,
& shiftr, shifti )
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dsortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call dsortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call dsortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call dsortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine dnapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
call dvout (logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call dvout (logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call dvout (logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %---------------%
c | End of dngets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/stat.h 0000644 0001750 0001750 00000001713 12277373057 012076 0000000 0000000 c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
c\SCCS Information: @(#)
c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
c
real t0, t1, t2, t3, t4, t5
save t0, t1, t2, t3, t4, t5
c
integer nopx, nbx, nrorth, nitref, nrstrt
real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
common /timing/
& nopx, nbx, nrorth, nitref, nrstrt,
& tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
arpack-ng-3.1.5/SRC/dgetv0.f 0000644 0001750 0001750 00000031642 12277373057 012316 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dgetv0
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call dgetv0
c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, IERR )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to dgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that dgetv0 is called.
c It should be set to 1 on the initial call to dgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Double precision N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine for vector output.
c dlarnv LAPACK routine for generating a random vector.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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
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: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dgetv0
& ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, 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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& resid(n), v(ldv,j), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Double precision
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dlarnv, dvout, dcopy, dgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, dnrm2
external ddot, dnrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call dlarnv (idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call dcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
end if
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm0 = ddot (n, resid, 1, workd, 1)
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = dnrm2(n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call dgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workd(n+1), 1)
call dgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = dnrm2(n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call dvout (logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call dvout (logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call dvout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 3) then
call dvout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of dgetv0 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssaup2.f 0000644 0001750 0001750 00000076707 12277373057 012355 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssaup2
c
c\Description:
c Intermediate level interface called by ssaupd.
c
c\Usage:
c call ssaup2
c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in ssaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in ssaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the second column
c of H starting at H(1,2). If ssaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Real array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in ssaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c sgetv0 ARPACK initial vector generation routine.
c ssaitr ARPACK Lanczos factorization routine.
c ssapps ARPACK application of implicit shifts routine.
c ssconv ARPACK convergence of Ritz values routine.
c sseigt ARPACK compute Ritz values and error bounds routine.
c ssgets ARPACK reorder Ritz values and error bounds routine.
c ssortr ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps two vectors.
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\Revision history:
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.7 DATE OF SID: 5/19/98 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssaup2
& ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Real
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, sgetv0, ssaitr, sscal, ssconv, sseigt, ssgets,
& ssapps, ssortr, svout, ivout, arscnd, sswap
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, snrm2, slamch
external sdot, snrm2, slamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0/3.0E+0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %--------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %--------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call ssaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | ssaitr was unable to build an Lanczos factorization |
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call ivout (logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call ssaitr (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 |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | ssaitr was unable to build an Lanczos factorization |
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call svout (logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call sseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call ssgets (ishift, which, nev, np, ritz, bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(np+1), 1)
call ssconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call ivout (logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call svout (logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call svout (logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call ssortr (wprime, .true., kplusp, ritz, bounds)
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call ssortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call ssortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call svout (logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call svout (logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call ssgets (ishift, which, nev, np, ritz, bounds,
& workl)
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_saup2: NEV and NP are')
call svout (logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call svout (logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:*NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, ssgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call svout (logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call svout (logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After ssapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call ssapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq,
& 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 ssaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = snrm2(n, resid, 1)
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call svout (logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call svout (logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call svout (logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %---------------%
c | End of ssaup2 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssconv.f 0000644 0001750 0001750 00000006456 12277373057 012445 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssconv
c
c\Description:
c Convergence testing for the symmetric Arnoldi eigenvalue routine.
c
c\Usage:
c call ssconv
c ( N, RITZ, BOUNDS, TOL, NCONV )
c
c\Arguments
c N Integer. (INPUT)
c Number of Ritz values to check for convergence.
c
c RITZ Real array of length N. (INPUT)
c The Ritz values to be checked for convergence.
c
c BOUNDS Real array of length N. (INPUT)
c Ritz estimates associated with the Ritz values in RITZ.
c
c TOL Real scalar. (INPUT)
c Desired relative accuracy for a Ritz value to be considered
c "converged".
c
c NCONV Integer scalar. (OUTPUT)
c Number of "converged" Ritz values.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c slamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
c
c\Remarks
c 1. Starting with version 2.4, this routine no longer uses the
c Parlett strategy using the gap conditions.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssconv (n, ritz, bounds, tol, nconv)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, nconv
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& ritz(n), bounds(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i
Real
& temp, eps23
c
c %-------------------%
c | External routines |
c %-------------------%
c
Real
& slamch
external slamch
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call arscnd (t0)
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0)
c
nconv = 0
do 10 i = 1, n
c
c %-----------------------------------------------------%
c | The i-th Ritz value is considered "converged" |
c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) |
c %-----------------------------------------------------%
c
temp = max( eps23, abs(ritz(i)) )
if ( bounds(i) .le. tol*temp ) then
nconv = nconv + 1
end if
c
10 continue
c
call arscnd (t1)
tsconv = tsconv + (t1 - t0)
c
return
c
c %---------------%
c | End of ssconv |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cnaitr.f 0000644 0001750 0001750 00000074467 12277373057 012421 0000000 0000000 c\BeginDoc
c
c\Name: cnaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in cnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call cnaitr
c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See cnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c cgetv0 ARPACK routine to generate the initial vector.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c cmout ARPACK utility routine that prints matrices
c cvout ARPACK utility routine that prints vectors.
c clanhs LAPACK routine that computes various norms of a matrix.
c clascl LAPACK routine for careful scaling of a matrix.
c slabad LAPACK routine for defining the underflow and overflow
c limits.
c slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c cscal Level 1 BLAS that scales a vector.
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\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: naitr.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in cnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cnaitr
& (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rone, rzero
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
& rone = 1.0E+0, rzero = 0.0E+0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cscal, csscal, cgemv, cgetv0,
& slabad, cvout, cmout, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex
& cdotc
Real
& slamch, scnrm2, clanhs, slapy2
external cdotc, scnrm2, clanhs, slamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------%
c
unfl = slamch( 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | cgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call svout (logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call cgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call ccopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call csscal (n, temp1, v(1,j), 1)
call csscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine clascl |
c %-----------------------------------------%
c
call clascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call clascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call ccopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call ccopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = scnrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call svout (logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call cvout (logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
call caxpy (j, one, workd(irj), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = scnrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call svout (logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %--------------------------------------------%
c
tst1 = slapy2(real(h(i,i)),aimag(h(i,i)))
& + slapy2(real(h(i+1,i+1)), aimag(h(i+1,i+1)))
if( tst1.eq.real(zero) )
& tst1 = clanhs( '1', k+np, h, ldh, workd(n+1) )
if( slapy2(real(h(i+1,i)),aimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call cmout (logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of cnaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssaupd.f 0000644 0001750 0001750 00000070372 12277373057 012427 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssaupd
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c ssaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call ssaupd
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 ssaupd. 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 ssaupd 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 -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
c
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N.
c
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 ssaupd 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), ssaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 sseupd. 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 sseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
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
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 Private (replicated) array on each PE or array allocated on
c the front end. See Data Distribution Note below.
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 ssteqr.
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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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 sseupd.
c
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 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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 ssaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c sstats ARPACK routine that initialize timing and other statistics
c variables.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c
c\Authors
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\Revision history:
c 12/15/93: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ssaup2, svout, ivout, arscnd, sstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch
external slamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = slamch('EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
call ssaup2
& ( 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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within ssaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_saupd: number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
call svout (logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
call svout (logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of ssaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/zneigh.f 0000644 0001750 0001750 00000020070 12277373057 012402 0000000 0000000 c\BeginDoc
c
c\Name: zneigh
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 zneigh
c ( RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
c
c\Arguments
c RNORM Double precision 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*16 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*16 array of length N. (OUTPUT)
c On output, RITZ(1:N) contains the eigenvalues of H.
c
c BOUNDS Complex*16 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*16 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*16 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 Double precision 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 zlahqr or ztrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd 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 zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine to compute the Schur form of an
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form
c zcopy Level 1 BLAS that copies one vector to another.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 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 zneigh (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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(n), h(ldh,n), q(ldq,n), ritz(n),
& workl(n*(n+3))
Double precision
& rwork(n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
& rone = 1.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer j, msglvl
Complex*16
& vl(1)
Double precision
& temp
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zlacpy, zlahqr, ztrevc, zcopy,
& zdscal, zmout, zvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
external dznrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mceigh
c
if (msglvl .gt. 2) then
call zmout (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 | zlahqr returns the full Schur form of H |
c | in WORKL(1:N**2), and the Schur vectors in q. |
c %----------------------------------------------------------%
c
call zlacpy ('All', n, n, h, ldh, workl, n)
call zlaset ('All', n, n, zero, one, q, ldq)
call zlahqr (.true., .true., n, 1, n, workl, ldh, ritz,
& 1, n, q, ldq, ierr)
if (ierr .ne. 0) go to 9000
c
call zcopy (n, q(n-1,1), ldq, bounds, 1)
if (msglvl .gt. 1) then
call zvout (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 ztrevc ('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 | ztrevc 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 = dznrm2( n, q(1,j), 1 )
call zdscal ( n, rone / temp, q(1,j), 1 )
10 continue
c
if (msglvl .gt. 1) then
call zcopy(n, q(n,1), ldq, workl, 1)
call zvout (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 zcopy(n, q(n,1), n, bounds, 1)
call zdscal(n, rnorm, bounds, 1)
c
if (msglvl .gt. 2) then
call zvout (logfil, n, ritz, ndigit,
& '_neigh: The eigenvalues of H')
call zvout (logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of zneigh |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/debug.h 0000644 0001750 0001750 00000001351 12277373057 012207 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/SRC/zsortc.f 0000644 0001750 0001750 00000017660 12277373057 012455 0000000 0000000 c\BeginDoc
c
c\Name: zsortc
c
c\Description:
c Sorts the Complex*16 array in X into the order
c specified by WHICH and optionally applies the permutation to the
c Double precision array Y.
c
c\Usage:
c call zsortc
c ( WHICH, APPLY, N, X, Y )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> sort X into increasing order of magnitude.
c 'SM' -> sort X into decreasing order of magnitude.
c 'LR' -> sort X with real(X) in increasing algebraic order
c 'SR' -> sort X with real(X) in decreasing algebraic order
c 'LI' -> sort X with imag(X) in increasing algebraic order
c 'SI' -> sort X with imag(X) in decreasing algebraic order
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to array Y.
c APPLY = .FALSE. -> do not apply the sorted order to array Y.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c X Complex*16 array of length N. (INPUT/OUTPUT)
c This is the array to be sorted.
c
c Y Complex*16 array of length N. (INPUT/OUTPUT)
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines called:
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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 Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortc.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine zsortc (which, apply, n, x, y)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& x(0:n-1), y(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Complex*16
& temp
Double precision
& temp1, temp2
c
c %--------------------%
c | External functions |
c %--------------------%
c
Double precision
& dlapy2
c
c %--------------------%
c | Intrinsic Functions |
c %--------------------%
Intrinsic
& dble, dimag
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'LM') then
c
c %--------------------------------------------%
c | Sort X into increasing order of magnitude. |
c %--------------------------------------------%
c
10 continue
if (igap .eq. 0) go to 9000
c
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
temp1 = dlapy2(dble(x(j)),dimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap)))
c
if (temp1.gt.temp2) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 30
end if
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c %--------------------------------------------%
c | Sort X into decreasing order of magnitude. |
c %--------------------------------------------%
c
40 continue
if (igap .eq. 0) go to 9000
c
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j .lt. 0) go to 60
c
temp1 = dlapy2(dble(x(j)),dimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap)))
c
if (temp1.lt.temp2) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LR') then
c
c %------------------------------------------------%
c | Sort XREAL into increasing order of algebraic. |
c %------------------------------------------------%
c
70 continue
if (igap .eq. 0) go to 9000
c
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (dble(x(j)).gt.dble(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'SR') then
c
c %------------------------------------------------%
c | Sort XREAL into decreasing order of algebraic. |
c %------------------------------------------------%
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (dble(x(j)).lt.dble(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
c
else if (which .eq. 'LI') then
c
c %--------------------------------------------%
c | Sort XIMAG into increasing algebraic order |
c %--------------------------------------------%
c
130 continue
if (igap .eq. 0) go to 9000
do 150 i = igap, n-1
j = i-igap
140 continue
c
if (j.lt.0) go to 150
c
if (dimag(x(j)).gt.dimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 150
endif
j = j-igap
go to 140
150 continue
igap = igap / 2
go to 130
c
else if (which .eq. 'SI') then
c
c %---------------------------------------------%
c | Sort XIMAG into decreasing algebraic order |
c %---------------------------------------------%
c
160 continue
if (igap .eq. 0) go to 9000
do 180 i = igap, n-1
j = i-igap
170 continue
c
if (j.lt.0) go to 180
c
if (dimag(x(j)).lt.dimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 180
endif
j = j-igap
go to 170
180 continue
igap = igap / 2
go to 160
end if
c
9000 continue
return
c
c %---------------%
c | End of zsortc |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/zneupd.f 0000644 0001750 0001750 00000104260 12277373057 012427 0000000 0000000 c\BeginDoc
c
c\Name: zneupd
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 ZNAUPD. ZNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of ZNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of ZNAUPD.
c
c\Usage:
c call zneupd
c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments:
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 ZNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to ZNAUPD 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, RWORK, INFO
c
c must be passed directly to ZNEUPD following the last call
c to ZNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to ZNAUPD and the call to ZNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex*16 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 ZNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c znaupd. They are not changed by zneupd.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 zneupd.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 zneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ztrsen.
c Re-enter subroutine zneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
c occurs.
c
c = -1: N must be positive.
c = -2: NEV must be positive.
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.
c = -8: Error return from LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ztrevc.
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 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c zmout ARPACK utility routine that prints matrices
c zvout ARPACK utility routine that prints vectors.
c zgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine that computes the Schur form of a
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form.
c ztrsen LAPACK routine that re-orders the Schur form.
c zunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c dlamch LAPACK routine that determines machine constants.
c ztrmm Level 3 BLAS matrix times an upper triangular matrix.
c zgeru Level 2 BLAS rank one update to a matrix.
c zcopy Level 1 BLAS that copies one vector to another .
c zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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 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
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
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 )
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex*16
& sigma
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Double precision
& rwork(ncv)
Complex*16
& d(nev) , resid(n) , v(ldv,ncv),
& z(ldz, nev),
& workd(3*n) , workl(lworkl), workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift, nconv2
Complex*16
& rnorm, temp, vl(1)
Double precision
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy , zgeru, zgeqr2, zlacpy, zmout,
& zunm2r, ztrmm, zvout, ivout,
& zlahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2, dlamch, dlapy2
external dznrm2, dlamch, dlapy2
c
Complex*16
& zdotc
external zdotc
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = dlamch('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
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
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 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 | 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. nconv) reord = .true.
endif
11 continue
c
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, 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 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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call zvout (logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
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,
& '_neupd: The upper triangular matrix ')
end if
end if
c
if (reord) then
c
c %-----------------------------------------------%
c | Reorder the computed upper triangular matrix. |
c %-----------------------------------------------%
c
call ztrsen('None' , 'V' , select ,
& ncv , workl(iuptri), ldh ,
& workl(invsub), ldq , workl(iheig),
& nconv2 , conds , sep ,
& workev , ncv , ierr)
c
if (nconv2 .lt. nconv) then
nconv = nconv2
end if
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
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,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
c
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call zcopy(ncv , workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call zcopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using zunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | ztrevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = dznrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = dble(one) / rtemp
call zdscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
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')
if (msglvl .gt. 3) then
call zmout(logfil , ncv, ncv ,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call zcopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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)
end if
c
else
c
c %--------------------------------------------------%
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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call zvout (logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call zvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call zvout (logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call zvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
& workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call zgeru (n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %---------------%
c | End of zneupd|
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cneupd.f 0000644 0001750 0001750 00000104125 12277373057 012400 0000000 0000000 c\BeginDoc
c
c\Name: cneupd
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 CNAUPD. CNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of CNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of CNAUPD.
c
c\Usage:
c call cneupd
c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments:
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 CNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to CNAUPD 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, RWORK, INFO
c
c must be passed directly to CNEUPD following the last call
c to CNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to CNAUPD and the call to CNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex 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 CNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c cnaupd. They are not changed by cneupd.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 cneupd.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 cneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ctrsen.
c Re-enter subroutine cneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ctrevc.
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: 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c cmout ARPACK utility routine that prints matrices
c cvout ARPACK utility routine that prints vectors.
c cgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c clacpy LAPACK matrix copy routine.
c clahqr LAPACK routine that computes the Schur form of a
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 ctrsen LAPACK routine that re-orders the Schur form.
c cunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c slamch LAPACK routine that determines machine constants.
c ctrmm Level 3 BLAS matrix times an upper triangular matrix.
c cgeru Level 2 BLAS rank one update to a matrix.
c ccopy Level 1 BLAS that copies one vector to another .
c cscal Level 1 BLAS that scales a vector.
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 complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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 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
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: neupd.F SID: 2.7 DATE OF SID: 09/20/00 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 )
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex
& sigma
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Real
& rwork(ncv)
Complex
& d(nev) , resid(n) , v(ldv,ncv),
& z(ldz, nev),
& workd(3*n) , workl(lworkl), workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift, nconv2
Complex
& rnorm, temp, vl(1)
Real
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy , cgeru, cgeqr2, clacpy, cmout,
& cunm2r, ctrmm, cvout, ivout,
& clahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2, slamch, slapy2
external scnrm2, slamch, slapy2
c
Complex
& cdotc
external cdotc
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
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
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 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 | 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. nconv) reord = .true.
endif
11 continue
c
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, 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 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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call cvout (logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
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,
& '_neupd: The upper triangular matrix ')
end if
end if
c
if (reord) then
c
c %-----------------------------------------------%
c | Reorder the computed upper triangular matrix. |
c %-----------------------------------------------%
c
call ctrsen('None' , 'V' , select ,
& ncv , workl(iuptri), ldh ,
& workl(invsub), ldq , workl(iheig),
& nconv2 , conds , sep ,
& workev , ncv , ierr)
c
if (nconv2 .lt. nconv) then
nconv = nconv2
end if
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
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,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
c
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call ccopy(ncv , workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call ccopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using cunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = scnrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = real(one) / rtemp
call csscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
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')
if (msglvl .gt. 3) then
call cmout(logfil , ncv, ncv ,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call ccopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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)
end if
c
else
c
c %--------------------------------------------------%
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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call cvout (logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call cvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call cvout (logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call cvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
& workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call cgeru (n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %---------------%
c | End of cneupd|
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dnaup2.f 0000644 0001750 0001750 00000076220 12277373057 012317 0000000 0000000 c\BeginDoc
c
c\Name: dnaup2
c
c\Description:
c Intermediate level interface called by dnaupd .
c
c\Usage:
c call dnaup2
c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dnaupd .
c MODE, ISHIFT, MXITER: see the definition of IPARAM in dnaupd .
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (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 RITZR, Double precision arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from dneigh .
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Double precision 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c dgetv0 ARPACK initial vector generation routine.
c dnaitr ARPACK Arnoldi factorization routine.
c dnapps ARPACK application of implicit shifts routine.
c dnconv ARPACK convergence of Ritz values routine.
c dneigh ARPACK compute Ritz values and error bounds routine.
c dngets ARPACK reorder Ritz values and error bounds routine.
c dsortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices
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 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 dswap Level 1 BLAS that swaps two vectors.
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: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dnaup2
& ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Double precision
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
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
Double precision
& 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)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy , dgetv0 , dnaitr , dnconv , dneigh ,
& dngets , dnapps , dvout , ivout , arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot , dnrm2 , dlapy2 , dlamch
external ddot , dnrm2 , dlapy2 , dlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = dlamch ('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call dnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 dnapps . |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call ivout (logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
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 |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call dneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from dneigh . |
c %----------------------------------------------------%
c
call dcopy (kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call dcopy (kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call dcopy (kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of dngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call dngets (ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call dnconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call ivout (logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call dvout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call dvout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call dvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call dvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with dngets , we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in dngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call dsortc (which, .true., nconv, ritzr, ritzi, bounds)
c
if (msglvl .gt. 1) then
call dvout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call dvout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call dvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
c %---- Scipy fix ------------------------------------------------
c | We must keep nev below this value, as otherwise we can get
c | np == 0 (note that dngets below can bump nev by 1). If np == 0,
c | the next call to `dnaitr` will write out-of-bounds.
c |
if (nev .gt. kplusp - 2) then
nev = kplusp - 2
end if
c |
c %---- Scipy fix end --------------------------------------------
c
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call dngets (ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call dvout (logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call dvout (logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call dvout (logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call dcopy (np, workl, 1, ritzr, 1)
call dcopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call dvout (logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call dvout (logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call dvout (logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call dnapps (n, nev, np, ritzr, ritzi, 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 dnaitr . |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = dnrm2 (n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call dmout (logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %---------------%
c | End of dnaup2 |
c %---------------%
c
return
end
arpack-ng-3.1.5/SRC/dsgets.f 0000644 0001750 0001750 00000016435 12277373057 012421 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsgets
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call dsgets
c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Double precision array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortr ARPACK utility sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
c dswap Level 1 BLAS that swaps the contents of two vectors.
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\Revision history:
c xx/xx/93: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsgets ( ishift, which, kev, np, ritz, bounds, shifts )
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dswap, dcopy, dsortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call dsortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call dswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call dswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call dsortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine dsapps. |
c %-------------------------------------------------------%
c
call dsortr ('SM', .true., np, bounds, ritz)
call dcopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is')
call ivout (logfil, 1, np, ndigit, '_sgets: NP is')
call dvout (logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call dvout (logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %---------------%
c | End of dsgets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dlaqrb.f 0000644 0001750 0001750 00000044020 12277373057 012364 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dlaqrb
c
c\Description:
c Compute the eigenvalues and the Schur decomposition of an upper
c Hessenberg submatrix in rows and columns ILO to IHI. Only the
c last component of the Schur vectors are computed.
c
c This is mostly a modification of the LAPACK routine dlahqr.
c
c\Usage:
c call dlaqrb
c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO )
c
c\Arguments
c WANTT Logical variable. (INPUT)
c = .TRUE. : the full Schur form T is required;
c = .FALSE.: only eigenvalues are required.
c
c N Integer. (INPUT)
c The order of the matrix H. N >= 0.
c
c ILO Integer. (INPUT)
c IHI Integer. (INPUT)
c It is assumed that H is already upper quasi-triangular in
c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
c ILO = 1). SLAQRB works primarily with the Hessenberg
c submatrix in rows and columns ILO to IHI, but applies
c transformations to all of H if WANTT is .TRUE..
c 1 <= ILO <= max(1,IHI); IHI <= N.
c
c H Double precision array, dimension (LDH,N). (INPUT/OUTPUT)
c On entry, the upper Hessenberg matrix H.
c On exit, if WANTT is .TRUE., H is upper quasi-triangular in
c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in
c standard form. If WANTT is .FALSE., the contents of H are
c unspecified on exit.
c
c LDH Integer. (INPUT)
c The leading dimension of the array H. LDH >= max(1,N).
c
c WR Double precision array, dimension (N). (OUTPUT)
c WI Double precision array, dimension (N). (OUTPUT)
c The real and imaginary parts, respectively, of the computed
c eigenvalues ILO to IHI are stored in the corresponding
c elements of WR and WI. If two eigenvalues are computed as a
c complex conjugate pair, they are stored in consecutive
c elements of WR and WI, say the i-th and (i+1)th, with
c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
c eigenvalues are stored in the same order as on the diagonal
c of the Schur form returned in H, with WR(i) = H(i,i), and, if
c H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
c
c Z Double precision array, dimension (N). (OUTPUT)
c On exit Z contains the last components of the Schur vectors.
c
c INFO Integer. (OUPUT)
c = 0: successful exit
c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI
c in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
c elements i+1:ihi of WR and WI contain those eigenvalues
c which have been successfully computed.
c
c\Remarks
c 1. None.
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dlabad LAPACK routine that computes machine constants.
c dlamch LAPACK routine that determines machine constants.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dlanv2 LAPACK routine that computes the Schur factorization of
c 2 by 2 nonsymmetric matrix in standard form.
c dlarfg LAPACK Householder reflection construction routine.
c dcopy Level 1 BLAS that copies one vector to another.
c drot Level 1 BLAS that applies a rotation to a 2 by 2 matrix.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c Modified from the LAPACK routine dlahqr so that only the
c last component of the Schur vectors are computed.
c
c\SCCS Information: @(#)
c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dlaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi,
& z, info )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
logical wantt
integer ihi, ilo, info, ldh, n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h( ldh, * ), wi( * ), wr( * ), z( * )
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, dat1, dat2
parameter (zero = 0.0D+0, one = 1.0D+0, dat1 = 7.5D-1,
& dat2 = -4.375D-1)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, i1, i2, itn, its, j, k, l, m, nh, nr
Double precision
& cs, h00, h10, h11, h12, h21, h22, h33, h33s,
& h43h34, h44, h44s, ovfl, s, smlnum, sn, sum,
& t1, t2, t3, tst1, ulp, unfl, v1, v2, v3
Double precision
& v( 3 ), work( 1 )
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch, dlanhs
external dlamch, dlanhs
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dlabad, dlanv2, dlarfg, drot
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
info = 0
c
c %--------------------------%
c | Quick return if possible |
c %--------------------------%
c
if( n.eq.0 )
& return
if( ilo.eq.ihi ) then
wr( ilo ) = h( ilo, ilo )
wi( ilo ) = zero
return
end if
c
c %---------------------------------------------%
c | Initialize the vector of last components of |
c | the Schur vectors for accumulation. |
c %---------------------------------------------%
c
do 5 j = 1, n-1
z(j) = zero
5 continue
z(n) = one
c
nh = ihi - ilo + 1
c
c %-------------------------------------------------------------%
c | Set machine-dependent constants for the stopping criterion. |
c | If norm(H) <= sqrt(OVFL), overflow should not occur. |
c %-------------------------------------------------------------%
c
unfl = dlamch( 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( nh / ulp )
c
c %---------------------------------------------------------------%
c | I1 and I2 are the indices of the first row and last column |
c | of H to which transformations must be applied. If eigenvalues |
c | only are computed, I1 and I2 are set inside the main loop. |
c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. |
c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. |
c %---------------------------------------------------------------%
c
if( wantt ) then
i1 = 1
i2 = n
do 8 i=1,i2-2
h(i1+i+1,i) = zero
8 continue
else
do 9 i=1, ihi-ilo-1
h(ilo+i+1,ilo+i-1) = zero
9 continue
end if
c
c %---------------------------------------------------%
c | ITN is the total number of QR iterations allowed. |
c %---------------------------------------------------%
c
itn = 30*nh
c
c ------------------------------------------------------------------
c The main loop begins here. I is the loop index and decreases from
c IHI to ILO in steps of 1 or 2. Each iteration of the loop works
c with the active submatrix in rows and columns L to I.
c Eigenvalues I+1 to IHI have already converged. Either L = ILO or
c H(L,L-1) is negligible so that the matrix splits.
c ------------------------------------------------------------------
c
i = ihi
10 continue
l = ilo
if( i.lt.ilo )
& go to 150
c %--------------------------------------------------------------%
c | Perform QR iterations on rows and columns ILO to I until a |
c | submatrix of order 1 or 2 splits off at the bottom because a |
c | subdiagonal element has become negligible. |
c %--------------------------------------------------------------%
do 130 its = 0, itn
c
c %----------------------------------------------%
c | Look for a single small subdiagonal element. |
c %----------------------------------------------%
c
do 20 k = i, l + 1, -1
tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', i-l+1, h( l, l ), ldh, work )
if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) )
& go to 30
20 continue
30 continue
l = k
if( l.gt.ilo ) then
c
c %------------------------%
c | H(L,L-1) is negligible |
c %------------------------%
c
h( l, l-1 ) = zero
end if
c
c %-------------------------------------------------------------%
c | Exit from loop if a submatrix of order 1 or 2 has split off |
c %-------------------------------------------------------------%
c
if( l.ge.i-1 )
& go to 140
c
c %---------------------------------------------------------%
c | Now the active submatrix is in rows and columns L to I. |
c | If eigenvalues only are being computed, only the active |
c | submatrix need be transformed. |
c %---------------------------------------------------------%
c
if( .not.wantt ) then
i1 = l
i2 = i
end if
c
if( its.eq.10 .or. its.eq.20 ) then
c
c %-------------------%
c | Exceptional shift |
c %-------------------%
c
s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) )
h44 = dat1*s
h33 = h44
h43h34 = dat2*s*s
c
else
c
c %-----------------------------------------%
c | Prepare to use Wilkinson's double shift |
c %-----------------------------------------%
c
h44 = h( i, i )
h33 = h( i-1, i-1 )
h43h34 = h( i, i-1 )*h( i-1, i )
end if
c
c %-----------------------------------------------------%
c | Look for two consecutive small subdiagonal elements |
c %-----------------------------------------------------%
c
do 40 m = i - 2, l, -1
c
c %---------------------------------------------------------%
c | Determine the effect of starting the double-shift QR |
c | iteration at row M, and see if this would make H(M,M-1) |
c | negligible. |
c %---------------------------------------------------------%
c
h11 = h( m, m )
h22 = h( m+1, m+1 )
h21 = h( m+1, m )
h12 = h( m, m+1 )
h44s = h44 - h11
h33s = h33 - h11
v1 = ( h33s*h44s-h43h34 ) / h21 + h12
v2 = h22 - h11 - h33s - h44s
v3 = h( m+2, m+1 )
s = abs( v1 ) + abs( v2 ) + abs( v3 )
v1 = v1 / s
v2 = v2 / s
v3 = v3 / s
v( 1 ) = v1
v( 2 ) = v2
v( 3 ) = v3
if( m.eq.l )
& go to 50
h00 = h( m-1, m-1 )
h10 = h( m, m-1 )
tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) )
if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 )
& go to 50
40 continue
50 continue
c
c %----------------------%
c | Double-shift QR step |
c %----------------------%
c
do 120 k = m, i - 1
c
c ------------------------------------------------------------
c The first iteration of this loop determines a reflection G
c from the vector V and applies it from left and right to H,
c thus creating a nonzero bulge below the subdiagonal.
c
c Each subsequent iteration determines a reflection G to
c restore the Hessenberg form in the (K-1)th column, and thus
c chases the bulge one step toward the bottom of the active
c submatrix. NR is the order of G.
c ------------------------------------------------------------
c
nr = min( 3, i-k+1 )
if( k.gt.m )
& call dcopy( nr, h( k, k-1 ), 1, v, 1 )
call dlarfg( nr, v( 1 ), v( 2 ), 1, t1 )
if( k.gt.m ) then
h( k, k-1 ) = v( 1 )
h( k+1, k-1 ) = zero
if( k.lt.i-1 )
& h( k+2, k-1 ) = zero
else if( m.gt.l ) then
h( k, k-1 ) = -h( k, k-1 )
end if
v2 = v( 2 )
t2 = t1*v2
if( nr.eq.3 ) then
v3 = v( 3 )
t3 = t1*v3
c
c %------------------------------------------------%
c | Apply G from the left to transform the rows of |
c | the matrix in columns K to I2. |
c %------------------------------------------------%
c
do 60 j = k, i2
sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j )
h( k, j ) = h( k, j ) - sum*t1
h( k+1, j ) = h( k+1, j ) - sum*t2
h( k+2, j ) = h( k+2, j ) - sum*t3
60 continue
c
c %----------------------------------------------------%
c | Apply G from the right to transform the columns of |
c | the matrix in rows I1 to min(K+3,I). |
c %----------------------------------------------------%
c
do 70 j = i1, min( k+3, i )
sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 )
h( j, k ) = h( j, k ) - sum*t1
h( j, k+1 ) = h( j, k+1 ) - sum*t2
h( j, k+2 ) = h( j, k+2 ) - sum*t3
70 continue
c
c %----------------------------------%
c | Accumulate transformations for Z |
c %----------------------------------%
c
sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 )
z( k ) = z( k ) - sum*t1
z( k+1 ) = z( k+1 ) - sum*t2
z( k+2 ) = z( k+2 ) - sum*t3
else if( nr.eq.2 ) then
c
c %------------------------------------------------%
c | Apply G from the left to transform the rows of |
c | the matrix in columns K to I2. |
c %------------------------------------------------%
c
do 90 j = k, i2
sum = h( k, j ) + v2*h( k+1, j )
h( k, j ) = h( k, j ) - sum*t1
h( k+1, j ) = h( k+1, j ) - sum*t2
90 continue
c
c %----------------------------------------------------%
c | Apply G from the right to transform the columns of |
c | the matrix in rows I1 to min(K+3,I). |
c %----------------------------------------------------%
c
do 100 j = i1, i
sum = h( j, k ) + v2*h( j, k+1 )
h( j, k ) = h( j, k ) - sum*t1
h( j, k+1 ) = h( j, k+1 ) - sum*t2
100 continue
c
c %----------------------------------%
c | Accumulate transformations for Z |
c %----------------------------------%
c
sum = z( k ) + v2*z( k+1 )
z( k ) = z( k ) - sum*t1
z( k+1 ) = z( k+1 ) - sum*t2
end if
120 continue
130 continue
c
c %-------------------------------------------------------%
c | Failure to converge in remaining number of iterations |
c %-------------------------------------------------------%
c
info = i
return
140 continue
if( l.eq.i ) then
c
c %------------------------------------------------------%
c | H(I,I-1) is negligible: one eigenvalue has converged |
c %------------------------------------------------------%
c
wr( i ) = h( i, i )
wi( i ) = zero
else if( l.eq.i-1 ) then
c
c %--------------------------------------------------------%
c | H(I-1,I-2) is negligible; |
c | a pair of eigenvalues have converged. |
c | |
c | Transform the 2-by-2 submatrix to standard Schur form, |
c | and compute and store the eigenvalues. |
c %--------------------------------------------------------%
c
call dlanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ),
& h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ),
& cs, sn )
if( wantt ) then
c
c %-----------------------------------------------------%
c | Apply the transformation to the rest of H and to Z, |
c | as required. |
c %-----------------------------------------------------%
c
if( i2.gt.i )
& call drot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh,
& cs, sn )
call drot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn )
sum = cs*z( i-1 ) + sn*z( i )
z( i ) = cs*z( i ) - sn*z( i-1 )
z( i-1 ) = sum
end if
end if
c
c %---------------------------------------------------------%
c | Decrement number of remaining iterations, and return to |
c | start of the main loop with new value of I. |
c %---------------------------------------------------------%
c
itn = itn - its
i = l - 1
go to 10
150 continue
return
c
c %---------------%
c | End of dlaqrb |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sseupd.f 0000644 0001750 0001750 00000103507 12277373057 012430 0000000 0000000 c\BeginDoc
c
c\Name: sseupd
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 SSAUPD for the linear operator OP prescribed by the MODE selection
c (see IPARAM(7) in SSAUPD documentation.) SSAUPD 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 SSAUPD 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
c call sseupd
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
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as a workspace for
c reordering the Ritz values.
c
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
c the Ritz values of OP computed by ssaupd 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 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.
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 SSAUPD.
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 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 SSAUPD 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 SSEUPD following the last call
c to SSAUPD. These arguments MUST NOT BE MODIFIED between
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(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
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 sseupd.
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 sseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 ssteqr.
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: 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 ssesrt ARPACK routine that sorts an array X, and applies the
c corresponding permutation to a matrix A.
c ssortr ssortr ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c svout ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c slamch LAPACK routine that determines machine constants.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a tridiagonal matrix.
c sger Level 2 BLAS rank one update to a matrix.
c scopy Level 1 BLAS that copies one vector to another .
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps the contents of two vectors.
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Revision history:
c 12/15/93: Version ' 2.1'
c
c\SCCS Information: @(#)
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 )
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Real
& 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
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& snrm2, slamch
external snrm2, slamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev .or. ncv .gt. n) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | ssaupd 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 ssaupd and is not |
c | modified by sseupd. |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
c | The following is used and set by sseupd. |
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | ssteqr. 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 ssteqr and by sseupd. |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+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 ssaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
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
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 | 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, 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. nconv) 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, 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)
c
call ssteqr('Identity', ncv, workl(ihd), workl(ihb),
& workl(iq) , ldq, workl(iw), ierr)
c
if (ierr .ne. 0) then
info = -8
go to 9000
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,
& '_seupd: NCV Ritz values of the final H matrix')
call svout(logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if ( .not. select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
c
temp = workl(ihd+leftptr-1)
workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
workl(ihd+rghtptr-1) = temp
call scopy(ncv, workl(iq+ncv*(leftptr-1)), 1,
& workl(iw), 1)
call scopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call scopy(ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
end if
c
30 if (msglvl .gt. 2) then
call svout (logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call scopy(nconv, workl(ihd), 1, d, 1)
c
else
c
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)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
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)
else
call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 ssaupd. |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c | They are only reordered. |
c %-------------------------------------------------------------%
c
call scopy (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
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
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)
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))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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)
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 %-----------------------------------------------------%
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)
c
c %-----------------------------------------------------%
c | Make a copy of the last row into |
c | workl(iw+ncv:iw+2*ncv), as it is needed again in |
c | the Ritz vector purification step below |
c %-----------------------------------------------------%
c
do 67 j = 1, nconv
workl(iw+ncv+j-1) = workl(ihb+j-1)
67 continue
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 ssaupd. |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
call sscal (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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call svout(logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
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,
& '_seupd: Converged Ritz values')
call svout(logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
c
if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
c
do 110 k=0, nconv-1
workl(iw+k) = workl(iw+ncv+k)
& / 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(iw+ncv+k)
& / (workl(iw+k)-one)
120 continue
c
end if
c
if (type .ne. 'REGULR')
& call sger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %---------------%
c | End of sseupd|
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sneupd.f 0000644 0001750 0001750 00000126144 12277373057 012425 0000000 0000000 c\BeginDoc
c
c\Name: sneupd
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 SNAUPD. SNAUPD 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 SNAUPD 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 SNAUPD.
c
c\Usage:
c call sneupd
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 )
c
c\Arguments:
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 SNAUPD. 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 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 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
c **** The remaining arguments MUST be the same as for the ****
c **** call to SNAUPD 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 SNEUPD following the last call
c to SNAUPD. These arguments MUST NOT BE MODIFIED between
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
c Upon INPUT: the NCV columns of V contain the Arnoldi basis
c vectors for OP as constructed by SNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(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
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 sneupd.
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 sneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine slahqr
c could not be reordered by LAPACK routine strsen.
c Re-enter subroutine sneupd 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
c the same space. Please notify the authors if this error
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 = -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 slahqr.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine strevc.
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: 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c slahqr LAPACK routine to compute the real Schur form of an
c upper Hessenberg matrix.
c slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK matrix initialization routine.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form.
c strsen LAPACK routine that re-orders the Schur form.
c strmm Level 3 BLAS matrix times an upper triangular matrix.
c sger Level 2 BLAS rank one update to a matrix.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 SNAUPD for OP to those of A*z = lambda*B*z.
c Set RVEC = .true. and HOWMNY = 'A', and
c compute
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 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 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
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
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)
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj , nconv2
logical reord
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
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2, slamch, sdot
external slapy2, snrm2, slamch, sdot
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
c | The following is used and set by SNEUPD. |
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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
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
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, 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 | 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. nconv) reord = .true.
endif
11 continue
c
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, 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. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call svout(logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call svout(logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
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,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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),
& nconv2 , conds ,
& sep , workl(ihbds) ,
& ncv , iwork ,
& 1 , ierr)
c
if (nconv2 .lt. nconv) then
nconv = nconv2
end if
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call svout(logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
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')
end if
end if
c
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call scopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
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)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
c | * Postmultiply V by Q using sorm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | strevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
call sscal( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
c
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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 )
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call sgemv('T', ncv, nconv, one, workl(invsub),
& ldq, workl(ihbds), 1, zero, workev, 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = slapy2(workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
call scopy(ncv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
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,
& ndigit, '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call scopy(nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call strmm('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
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)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = slapy2( workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
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
& + sigmar
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)
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)
c
end if
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
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,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
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,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1) /
& workl(iheigr+j-1)
else if (iconj .eq. 0) then
temp = slapy2( 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) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
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)
c
end if
c
9000 continue
c
return
c
c %---------------%
c | End of SNEUPD |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/Makefile.am 0000644 0001750 0001750 00000001373 12277373057 013010 0000000 0000000 noinst_LTLIBRARIES = libarpacksrc.la
libarpacksrc_la_SOURCES = \
sgetv0.f slaqrb.f sstqrb.f ssortc.f ssortr.f sstatn.f sstats.f \
snaitr.f snapps.f snaup2.f snaupd.f snconv.f sneigh.f sngets.f \
ssaitr.f ssapps.f ssaup2.f ssaupd.f ssconv.f sseigt.f ssgets.f \
sneupd.f sseupd.f ssesrt.f \
dgetv0.f dlaqrb.f dstqrb.f dsortc.f dsortr.f dstatn.f dstats.f \
dnaitr.f dnapps.f dnaup2.f dnaupd.f dnconv.f dneigh.f dngets.f \
dsaitr.f dsapps.f dsaup2.f dsaupd.f dsconv.f dseigt.f dsgets.f \
dneupd.f dseupd.f dsesrt.f \
cnaitr.f cnapps.f cnaup2.f cnaupd.f cneigh.f cneupd.f cngets.f \
cgetv0.f csortc.f cstatn.f \
znaitr.f znapps.f znaup2.f znaupd.f zneigh.f zneupd.f zngets.f \
zgetv0.f zsortc.f zstatn.f
EXTRA_DIST = debug.h stat.h version.h arpack-ng-3.1.5/SRC/dnapps.f 0000644 0001750 0001750 00000055721 12277373057 012416 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dnapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call dnapps
c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Double precision array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to dnapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices.
c dvout ARPACK utility routine that prints vectors.
c dlabad LAPACK routine that computes machine constants.
c dlacpy LAPACK matrix copy routine.
c dlamch LAPACK routine that determines machine constants.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dlarf LAPACK routine that applies Householder reflection to
c a matrix.
c dlarfg LAPACK Householder reflection construction routine.
c dlartg LAPACK Givens rotation construction routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another .
c dscal Level 1 BLAS that scales a vector.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
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
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dnapps
& ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Double precision
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf,
& dlaset, dlabad, arscnd, dlartg
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch, dlanhs, dlapy2
external dlamch, dlanhs, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------------%
c
unfl = dlamch( 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call ivout (logfil, 1, jj, ndigit,
& '_napps: shift number.')
call dvout (logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call dvout (logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call dvout (logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call ivout (logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call dlartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = dlapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call dlarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call dlarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call dlarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call dlarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call dscal( kplusp-j+1, -one, h(j+1,j), ldh )
call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call dvout (logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call dvout (logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call ivout (logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call dmout (logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %---------------%
c | End of dnapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsaup2.f 0000644 0001750 0001750 00000077174 12277373057 012335 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsaup2
c
c\Description:
c Intermediate level interface called by dsaupd.
c
c\Usage:
c call dsaup2
c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in dsaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in dsaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the arscnd column
c of H starting at H(1,2). If dsaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Double precision array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in dsaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c dgetv0 ARPACK initial vector generation routine.
c dsaitr ARPACK Lanczos factorization routine.
c dsapps ARPACK application of implicit shifts routine.
c dsconv ARPACK convergence of Ritz values routine.
c dseigt ARPACK compute Ritz values and error bounds routine.
c dsgets ARPACK reorder Ritz values and error bounds routine.
c dsortr ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dlamch LAPACK routine that determines machine constants.
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 dswap Level 1 BLAS that swaps two vectors.
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\Revision history:
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.7 DATE OF SID: 5/19/98 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsaup2
& ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Double precision
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dgetv0, dsaitr, dscal, dsconv, dseigt, dsgets,
& dsapps, dsortr, dvout, ivout, arscnd, dswap
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, dnrm2, dlamch
external ddot, dnrm2, dlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = dlamch('Epsilon-Machine')
eps23 = eps23**(2.0D+0/3.0D+0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %--------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %--------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call dgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call dsaitr (ido, bmat, n, 0, nev0, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | dsaitr was unable to build an Lanczos factorization |
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call ivout (logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call dsaitr (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 |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | dsaitr was unable to build an Lanczos factorization |
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call dvout (logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call dseigt (rnorm, kplusp, h, ldh, ritz, bounds, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call dsgets (ishift, which, nev, np, ritz, bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(np+1), 1)
call dsconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call ivout (logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call dvout (logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call dvout (logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call dsortr (wprime, .true., kplusp, ritz, bounds)
nevd2 = nev0 / 2
nevm2 = nev0 - nevd2
if ( nev .gt. 1 ) then
np = kplusp - nev0
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call dsortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call dsortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call dvout (logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call dvout (logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call dsgets (ishift, which, nev, np, ritz, bounds,
& workl)
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_saup2: NEV and NP are')
call dvout (logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call dvout (logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:*NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, dsgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call dvout (logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call dvout (logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After dsapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call dsapps (n, nev, np, ritz, v, ldv, h, ldh, resid, q, ldq,
& 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 dsaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = dnrm2(n, resid, 1)
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call dvout (logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call dvout (logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call dvout (logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %---------------%
c | End of dsaup2 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/zngets.f 0000644 0001750 0001750 00000012712 12277373057 012434 0000000 0000000 c\BeginDoc
c
c\Name: zngets
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call zngets
c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c zsortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c zvout ARPACK utility routine that prints vectors.
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: ngets.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine zngets ( ishift, which, kev, np, ritz, bounds)
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zvout, zsortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call zsortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine znapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call zsortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
call zvout (logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call zvout (logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %---------------%
c | End of zngets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssortr.f 0000644 0001750 0001750 00000012274 12277373057 012461 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssortr
c
c\Description:
c Sort the array X1 in the order specified by WHICH and optionally
c applies the permutation to the array X2.
c
c\Usage:
c call ssortr
c ( WHICH, APPLY, N, X1, X2 )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> X1 is sorted into increasing order of magnitude.
c 'SM' -> X1 is sorted into decreasing order of magnitude.
c 'LA' -> X1 is sorted into increasing order of algebraic.
c 'SA' -> X1 is sorted into decreasing order of algebraic.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to X2.
c APPLY = .FALSE. -> do not apply the sorted order to X2.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c X1 Real array of length N. (INPUT/OUTPUT)
c The array to be sorted.
c
c X2 Real array of length N. (INPUT/OUTPUT)
c Only referenced if APPLY = .TRUE.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
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\Revision history:
c 12/16/93: Version ' 2.1'.
c Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssortr (which, apply, n, x1, x2)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& x1(0:n-1), x2(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Real
& temp
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'SA') then
c
c X1 is sorted into decreasing order of algebraic.
c
10 continue
if (igap .eq. 0) go to 9000
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
if (x1(j).lt.x1(j+igap)) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 30
endif
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c X1 is sorted into decreasing order of magnitude.
c
40 continue
if (igap .eq. 0) go to 9000
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j.lt.0) go to 60
c
if (abs(x1(j)).lt.abs(x1(j+igap))) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LA') then
c
c X1 is sorted into increasing order of algebraic.
c
70 continue
if (igap .eq. 0) go to 9000
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (x1(j).gt.x1(j+igap)) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'LM') then
c
c X1 is sorted into increasing order of magnitude.
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (abs(x1(j)).gt.abs(x1(j+igap))) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
end if
c
9000 continue
return
c
c %---------------%
c | End of ssortr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/snapps.f 0000644 0001750 0001750 00000055515 12277373057 012436 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: snapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call snapps
c ( N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Real array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to snapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices.
c svout ARPACK utility routine that prints vectors.
c slabad LAPACK routine that computes machine constants.
c slacpy LAPACK matrix copy routine.
c slamch LAPACK routine that determines machine constants.
c slanhs LAPACK routine that computes various norms of a matrix.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slarf LAPACK routine that applies Householder reflection to
c a matrix.
c slarfg LAPACK Householder reflection construction routine.
c slartg LAPACK Givens rotation construction routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another .
c sscal Level 1 BLAS that scales a vector.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
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
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine slahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine snapps
& ( n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Real
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slarfg, slarf,
& slaset, slabad, arscnd, slartg
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch, slanhs, slapy2
external slamch, slanhs, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------------%
c
unfl = slamch( 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call ivout (logfil, 1, jj, ndigit,
& '_napps: shift number.')
call svout (logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call svout (logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call svout (logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call ivout (logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call slartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = slapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call slarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call slarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call slarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call slarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call sscal( kplusp-j+1, -one, h(j+1,j), ldh )
call sscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call sscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call sgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call saxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call svout (logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call svout (logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call ivout (logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call smout (logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %---------------%
c | End of snapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sseigt.f 0000644 0001750 0001750 00000011755 12277373057 012426 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: sseigt
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call sseigt
c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c RNORM Real scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Real N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Real array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Real work array of length 3*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 sstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c sstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine sseigt
& ( rnorm, n, h, ldh, eig, bounds, workl, 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, ldh, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, sstqrb, svout, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call svout (logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call svout (logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
call scopy (n, h(1,2), 1, eig, 1)
call scopy (n-1, h(2,1), 1, workl, 1)
call sstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
if (msglvl .gt. 1) then
call svout (logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of sseigt |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsortr.f 0000644 0001750 0001750 00000012354 12277373057 012441 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsortr
c
c\Description:
c Sort the array X1 in the order specified by WHICH and optionally
c applies the permutation to the array X2.
c
c\Usage:
c call dsortr
c ( WHICH, APPLY, N, X1, X2 )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> X1 is sorted into increasing order of magnitude.
c 'SM' -> X1 is sorted into decreasing order of magnitude.
c 'LA' -> X1 is sorted into increasing order of algebraic.
c 'SA' -> X1 is sorted into decreasing order of algebraic.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to X2.
c APPLY = .FALSE. -> do not apply the sorted order to X2.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c X1 Double precision array of length N. (INPUT/OUTPUT)
c The array to be sorted.
c
c X2 Double precision array of length N. (INPUT/OUTPUT)
c Only referenced if APPLY = .TRUE.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
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\Revision history:
c 12/16/93: Version ' 2.1'.
c Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortr.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsortr (which, apply, n, x1, x2)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& x1(0:n-1), x2(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Double precision
& temp
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'SA') then
c
c X1 is sorted into decreasing order of algebraic.
c
10 continue
if (igap .eq. 0) go to 9000
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
if (x1(j).lt.x1(j+igap)) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 30
endif
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c X1 is sorted into decreasing order of magnitude.
c
40 continue
if (igap .eq. 0) go to 9000
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j.lt.0) go to 60
c
if (abs(x1(j)).lt.abs(x1(j+igap))) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LA') then
c
c X1 is sorted into increasing order of algebraic.
c
70 continue
if (igap .eq. 0) go to 9000
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (x1(j).gt.x1(j+igap)) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'LM') then
c
c X1 is sorted into increasing order of magnitude.
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (abs(x1(j)).gt.abs(x1(j+igap))) then
temp = x1(j)
x1(j) = x1(j+igap)
x1(j+igap) = temp
if (apply) then
temp = x2(j)
x2(j) = x2(j+igap)
x2(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
end if
c
9000 continue
return
c
c %---------------%
c | End of dsortr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsortc.f 0000644 0001750 0001750 00000022046 12277373057 012421 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsortc
c
c\Description:
c Sorts the complex array in XREAL and XIMAG into the order
c specified by WHICH and optionally applies the permutation to the
c real array Y. It is assumed that if an element of XIMAG is
c nonzero, then its negative is also an element. In other words,
c both members of a complex conjugate pair are to be sorted and the
c pairs are kept adjacent to each other.
c
c\Usage:
c call dsortc
c ( WHICH, APPLY, N, XREAL, XIMAG, Y )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude.
c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude.
c 'LR' -> sort XREAL into increasing order of algebraic.
c 'SR' -> sort XREAL into decreasing order of algebraic.
c 'LI' -> sort XIMAG into increasing order of magnitude.
c 'SI' -> sort XIMAG into decreasing order of magnitude.
c NOTE: If an element of XIMAG is non-zero, then its negative
c is also an element.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to array Y.
c APPLY = .FALSE. -> do not apply the sorted order to array Y.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c XREAL, Double precision array of length N. (INPUT/OUTPUT)
c XIMAG Real and imaginary part of the array to be sorted.
c
c Y Double precision array of length N. (INPUT/OUTPUT)
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
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\Revision history:
c xx/xx/92: Version ' 2.1'
c Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsortc (which, apply, n, xreal, ximag, y)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& xreal(0:n-1), ximag(0:n-1), y(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Double precision
& temp, temp1, temp2
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2
external dlapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'LM') then
c
c %------------------------------------------------------%
c | Sort XREAL,XIMAG into increasing order of magnitude. |
c %------------------------------------------------------%
c
10 continue
if (igap .eq. 0) go to 9000
c
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
temp1 = dlapy2(xreal(j),ximag(j))
temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
c
if (temp1.gt.temp2) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 30
end if
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c %------------------------------------------------------%
c | Sort XREAL,XIMAG into decreasing order of magnitude. |
c %------------------------------------------------------%
c
40 continue
if (igap .eq. 0) go to 9000
c
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j .lt. 0) go to 60
c
temp1 = dlapy2(xreal(j),ximag(j))
temp2 = dlapy2(xreal(j+igap),ximag(j+igap))
c
if (temp1.lt.temp2) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LR') then
c
c %------------------------------------------------%
c | Sort XREAL into increasing order of algebraic. |
c %------------------------------------------------%
c
70 continue
if (igap .eq. 0) go to 9000
c
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (xreal(j).gt.xreal(j+igap)) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'SR') then
c
c %------------------------------------------------%
c | Sort XREAL into decreasing order of algebraic. |
c %------------------------------------------------%
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (xreal(j).lt.xreal(j+igap)) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
c
else if (which .eq. 'LI') then
c
c %------------------------------------------------%
c | Sort XIMAG into increasing order of magnitude. |
c %------------------------------------------------%
c
130 continue
if (igap .eq. 0) go to 9000
do 150 i = igap, n-1
j = i-igap
140 continue
c
if (j.lt.0) go to 150
c
if (abs(ximag(j)).gt.abs(ximag(j+igap))) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 150
endif
j = j-igap
go to 140
150 continue
igap = igap / 2
go to 130
c
else if (which .eq. 'SI') then
c
c %------------------------------------------------%
c | Sort XIMAG into decreasing order of magnitude. |
c %------------------------------------------------%
c
160 continue
if (igap .eq. 0) go to 9000
do 180 i = igap, n-1
j = i-igap
170 continue
c
if (j.lt.0) go to 180
c
if (abs(ximag(j)).lt.abs(ximag(j+igap))) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 180
endif
j = j-igap
go to 170
180 continue
igap = igap / 2
go to 160
end if
c
9000 continue
return
c
c %---------------%
c | End of dsortc |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sstqrb.f 0000644 0001750 0001750 00000040464 12277373057 012445 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: sstqrb
c
c\Description:
c Computes all eigenvalues and the last component of the eigenvectors
c of a symmetric tridiagonal matrix using the implicit QL or QR method.
c
c This is mostly a modification of the LAPACK routine ssteqr.
c See Remarks.
c
c\Usage:
c call sstqrb
c ( N, D, E, Z, WORK, INFO )
c
c\Arguments
c N Integer. (INPUT)
c The number of rows and columns in the matrix. N >= 0.
c
c D Real array, dimension (N). (INPUT/OUTPUT)
c On entry, D contains the diagonal elements of the
c tridiagonal matrix.
c On exit, D contains the eigenvalues, in ascending order.
c If an error exit is made, the eigenvalues are correct
c for indices 1,2,...,INFO-1, but they are unordered and
c may not be the smallest eigenvalues of the matrix.
c
c E Real array, dimension (N-1). (INPUT/OUTPUT)
c On entry, E contains the subdiagonal elements of the
c tridiagonal matrix in positions 1 through N-1.
c On exit, E has been destroyed.
c
c Z Real array, dimension (N). (OUTPUT)
c On exit, Z contains the last row of the orthonormal
c eigenvector matrix of the symmetric tridiagonal matrix.
c If an error exit is made, Z contains the last row of the
c eigenvector matrix associated with the stored eigenvalues.
c
c WORK Real array, dimension (max(1,2*N-2)). (WORKSPACE)
c Workspace used in accumulating the transformation for
c computing the last components of the eigenvectors.
c
c INFO Integer. (OUTPUT)
c = 0: normal return.
c < 0: if INFO = -i, the i-th argument had an illegal value.
c > 0: if INFO = +i, the i-th eigenvalue has not converged
c after a total of 30*N iterations.
c
c\Remarks
c 1. None.
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another.
c sswap Level 1 BLAS that swaps the contents of two vectors.
c lsame LAPACK character comparison routine.
c slae2 LAPACK routine that computes the eigenvalues of a 2-by-2
c symmetric matrix.
c slaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric
c matrix.
c slamch LAPACK routine that determines machine constants.
c slanst LAPACK routine that computes the norm of a matrix.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slartg LAPACK Givens rotation construction routine.
c slascl LAPACK routine for careful scaling of a matrix.
c slaset LAPACK matrix initialization routine.
c slasr LAPACK routine that applies an orthogonal transformation to
c a matrix.
c slasrt LAPACK sorting routine.
c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a symmetric tridiagonal matrix.
c xerbla LAPACK error handler routine.
c
c\Authors
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: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c 1. Starting with version 2.5, this routine is a modified version
c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted,
c only commeted out and new lines inserted.
c All lines commented out have "c$$$" at the beginning.
c Note that the LAPACK version 1.0 subroutine SSTEQR contained
c bugs.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine sstqrb ( n, d, e, z, work, info )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer info, n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& d( n ), e( n-1 ), z( n ), work( 2*n-2 )
c
c .. parameters ..
Real
& zero, one, two, three
parameter ( zero = 0.0E+0, one = 1.0E+0,
& two = 2.0E+0, three = 3.0E+0 )
integer maxit
parameter ( maxit = 30 )
c ..
c .. local scalars ..
integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend,
& lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1,
& nm1, nmaxit
Real
& anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2,
& s, safmax, safmin, ssfmax, ssfmin, tst
c ..
c .. external functions ..
logical lsame
Real
& slamch, slanst, slapy2
external lsame, slamch, slanst, slapy2
c ..
c .. external subroutines ..
external slae2, slaev2, slartg, slascl, slaset, slasr,
& slasrt, sswap, xerbla
c ..
c .. intrinsic functions ..
intrinsic abs, max, sign, sqrt
c ..
c .. executable statements ..
c
c test the input parameters.
c
info = 0
c
c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN
c$$$ ICOMPZ = 0
c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
c$$$ ICOMPZ = 1
c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
c$$$ ICOMPZ = 2
c$$$ ELSE
c$$$ ICOMPZ = -1
c$$$ END IF
c$$$ IF( ICOMPZ.LT.0 ) THEN
c$$$ INFO = -1
c$$$ ELSE IF( N.LT.0 ) THEN
c$$$ INFO = -2
c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
c$$$ $ N ) ) ) THEN
c$$$ INFO = -6
c$$$ END IF
c$$$ IF( INFO.NE.0 ) THEN
c$$$ CALL XERBLA( 'SSTEQR', -INFO )
c$$$ RETURN
c$$$ END IF
c
c *** New starting with version 2.5 ***
c
icompz = 2
c *************************************
c
c quick return if possible
c
if( n.eq.0 )
$ return
c
if( n.eq.1 ) then
if( icompz.eq.2 ) z( 1 ) = one
return
end if
c
c determine the unit roundoff and over/underflow thresholds.
c
eps = slamch( 'e' )
eps2 = eps**2
safmin = slamch( 's' )
safmax = one / safmin
ssfmax = sqrt( safmax ) / three
ssfmin = sqrt( safmin ) / eps2
c
c compute the eigenvalues and eigenvectors of the tridiagonal
c matrix.
c
c$$ if( icompz.eq.2 )
c$$$ $ call slaset( 'full', n, n, zero, one, z, ldz )
c
c *** New starting with version 2.5 ***
c
if ( icompz .eq. 2 ) then
do 5 j = 1, n-1
z(j) = zero
5 continue
z( n ) = one
end if
c *************************************
c
nmaxit = n*maxit
jtot = 0
c
c determine where the matrix splits and choose ql or qr iteration
c for each block, according to whether top or bottom diagonal
c element is smaller.
c
l1 = 1
nm1 = n - 1
c
10 continue
if( l1.gt.n )
$ go to 160
if( l1.gt.1 )
$ e( l1-1 ) = zero
if( l1.le.nm1 ) then
do 20 m = l1, nm1
tst = abs( e( m ) )
if( tst.eq.zero )
$ go to 30
if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+
$ 1 ) ) ) )*eps ) then
e( m ) = zero
go to 30
end if
20 continue
end if
m = n
c
30 continue
l = l1
lsv = l
lend = m
lendsv = lend
l1 = m + 1
if( lend.eq.l )
$ go to 10
c
c scale submatrix in rows and columns l to lend
c
anorm = slanst( 'i', lend-l+1, d( l ), e( l ) )
iscale = 0
if( anorm.eq.zero )
$ go to 10
if( anorm.gt.ssfmax ) then
iscale = 1
call slascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n,
$ info )
call slascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n,
$ info )
else if( anorm.lt.ssfmin ) then
iscale = 2
call slascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n,
$ info )
call slascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n,
$ info )
end if
c
c choose between ql and qr iteration
c
if( abs( d( lend ) ).lt.abs( d( l ) ) ) then
lend = lsv
l = lendsv
end if
c
if( lend.gt.l ) then
c
c ql iteration
c
c look for small subdiagonal element.
c
40 continue
if( l.ne.lend ) then
lendm1 = lend - 1
do 50 m = l, lendm1
tst = abs( e( m ) )**2
if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+
$ safmin )go to 60
50 continue
end if
c
m = lend
c
60 continue
if( m.lt.lend )
$ e( m ) = zero
p = d( l )
if( m.eq.l )
$ go to 80
c
c if remaining matrix is 2-by-2, use slae2 or slaev2
c to compute its eigensystem.
c
if( m.eq.l+1 ) then
if( icompz.gt.0 ) then
call slaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s )
work( l ) = c
work( n-1+l ) = s
c$$$ call slasr( 'r', 'v', 'b', n, 2, work( l ),
c$$$ $ work( n-1+l ), z( 1, l ), ldz )
c
c *** New starting with version 2.5 ***
c
tst = z(l+1)
z(l+1) = c*tst - s*z(l)
z(l) = s*tst + c*z(l)
c *************************************
else
call slae2( d( l ), e( l ), d( l+1 ), rt1, rt2 )
end if
d( l ) = rt1
d( l+1 ) = rt2
e( l ) = zero
l = l + 2
if( l.le.lend )
$ go to 40
go to 140
end if
c
if( jtot.eq.nmaxit )
$ go to 140
jtot = jtot + 1
c
c form shift.
c
g = ( d( l+1 )-p ) / ( two*e( l ) )
r = slapy2( g, one )
g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) )
c
s = one
c = one
p = zero
c
c inner loop
c
mm1 = m - 1
do 70 i = mm1, l, -1
f = s*e( i )
b = c*e( i )
call slartg( g, f, c, s, r )
if( i.ne.m-1 )
$ e( i+1 ) = r
g = d( i+1 ) - p
r = ( d( i )-g )*s + two*c*b
p = s*r
d( i+1 ) = g + p
g = c*r - b
c
c if eigenvectors are desired, then save rotations.
c
if( icompz.gt.0 ) then
work( i ) = c
work( n-1+i ) = -s
end if
c
70 continue
c
c if eigenvectors are desired, then apply saved rotations.
c
if( icompz.gt.0 ) then
mm = m - l + 1
c$$$ call slasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ),
c$$$ $ z( 1, l ), ldz )
c
c *** New starting with version 2.5 ***
c
call slasr( 'r', 'v', 'b', 1, mm, work( l ),
& work( n-1+l ), z( l ), 1 )
c *************************************
end if
c
d( l ) = d( l ) - p
e( l ) = g
go to 40
c
c eigenvalue found.
c
80 continue
d( l ) = p
c
l = l + 1
if( l.le.lend )
$ go to 40
go to 140
c
else
c
c qr iteration
c
c look for small superdiagonal element.
c
90 continue
if( l.ne.lend ) then
lendp1 = lend + 1
do 100 m = l, lendp1, -1
tst = abs( e( m-1 ) )**2
if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+
$ safmin )go to 110
100 continue
end if
c
m = lend
c
110 continue
if( m.gt.lend )
$ e( m-1 ) = zero
p = d( l )
if( m.eq.l )
$ go to 130
c
c if remaining matrix is 2-by-2, use slae2 or slaev2
c to compute its eigensystem.
c
if( m.eq.l-1 ) then
if( icompz.gt.0 ) then
call slaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s )
c$$$ work( m ) = c
c$$$ work( n-1+m ) = s
c$$$ call slasr( 'r', 'v', 'f', n, 2, work( m ),
c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz )
c
c *** New starting with version 2.5 ***
c
tst = z(l)
z(l) = c*tst - s*z(l-1)
z(l-1) = s*tst + c*z(l-1)
c *************************************
else
call slae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 )
end if
d( l-1 ) = rt1
d( l ) = rt2
e( l-1 ) = zero
l = l - 2
if( l.ge.lend )
$ go to 90
go to 140
end if
c
if( jtot.eq.nmaxit )
$ go to 140
jtot = jtot + 1
c
c form shift.
c
g = ( d( l-1 )-p ) / ( two*e( l-1 ) )
r = slapy2( g, one )
g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) )
c
s = one
c = one
p = zero
c
c inner loop
c
lm1 = l - 1
do 120 i = m, lm1
f = s*e( i )
b = c*e( i )
call slartg( g, f, c, s, r )
if( i.ne.m )
$ e( i-1 ) = r
g = d( i ) - p
r = ( d( i+1 )-g )*s + two*c*b
p = s*r
d( i ) = g + p
g = c*r - b
c
c if eigenvectors are desired, then save rotations.
c
if( icompz.gt.0 ) then
work( i ) = c
work( n-1+i ) = s
end if
c
120 continue
c
c if eigenvectors are desired, then apply saved rotations.
c
if( icompz.gt.0 ) then
mm = l - m + 1
c$$$ call slasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ),
c$$$ $ z( 1, m ), ldz )
c
c *** New starting with version 2.5 ***
c
call slasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ),
& z( m ), 1 )
c *************************************
end if
c
d( l ) = d( l ) - p
e( lm1 ) = g
go to 90
c
c eigenvalue found.
c
130 continue
d( l ) = p
c
l = l - 1
if( l.ge.lend )
$ go to 90
go to 140
c
end if
c
c undo scaling if necessary
c
140 continue
if( iscale.eq.1 ) then
call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1,
$ d( lsv ), n, info )
call slascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ),
$ n, info )
else if( iscale.eq.2 ) then
call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1,
$ d( lsv ), n, info )
call slascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ),
$ n, info )
end if
c
c check for no convergence to an eigenvalue after a total
c of n*maxit iterations.
c
if( jtot.lt.nmaxit )
$ go to 10
do 150 i = 1, n - 1
if( e( i ).ne.zero )
$ info = info + 1
150 continue
go to 190
c
c order eigenvalues and eigenvectors.
c
160 continue
if( icompz.eq.0 ) then
c
c use quick sort
c
call slasrt( 'i', n, d, info )
c
else
c
c use selection sort to minimize swaps of eigenvectors
c
do 180 ii = 2, n
i = ii - 1
k = i
p = d( i )
do 170 j = ii, n
if( d( j ).lt.p ) then
k = j
p = d( j )
end if
170 continue
if( k.ne.i ) then
d( k ) = d( i )
d( i ) = p
c$$$ call sswap( n, z( 1, i ), 1, z( 1, k ), 1 )
c *** New starting with version 2.5 ***
c
p = z(k)
z(k) = z(i)
z(i) = p
c *************************************
end if
180 continue
end if
c
190 continue
return
c
c %---------------%
c | End of sstqrb |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssesrt.f 0000644 0001750 0001750 00000012310 12277373057 012437 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssesrt
c
c\Description:
c Sort the array X in the order specified by WHICH and optionally
c apply the permutation to the columns of the matrix A.
c
c\Usage:
c call ssesrt
c ( WHICH, APPLY, N, X, NA, A, LDA)
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> X is sorted into increasing order of magnitude.
c 'SM' -> X is sorted into decreasing order of magnitude.
c 'LA' -> X is sorted into increasing order of algebraic.
c 'SA' -> X is sorted into decreasing order of algebraic.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to A.
c APPLY = .FALSE. -> do not apply the sorted order to A.
c
c N Integer. (INPUT)
c Dimension of the array X.
c
c X Real array of length N. (INPUT/OUTPUT)
c The array to be sorted.
c
c NA Integer. (INPUT)
c Number of rows of the matrix A.
c
c A Real array of length NA by N. (INPUT/OUTPUT)
c
c LDA Integer. (INPUT)
c Leading dimension of A.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines
c sswap Level 1 BLAS that swaps the contents of two vectors.
c
c\Authors
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\Revision history:
c 12/15/93: Version ' 2.1'.
c Adapted from the sort routine in LANSO and
c the ARPACK code ssortr
c
c\SCCS Information: @(#)
c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssesrt (which, apply, n, x, na, a, lda)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer lda, n, na
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& x(0:n-1), a(lda, 0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Real
& temp
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external sswap
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'SA') then
c
c X is sorted into decreasing order of algebraic.
c
10 continue
if (igap .eq. 0) go to 9000
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
if (x(j).lt.x(j+igap)) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 30
endif
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c X is sorted into decreasing order of magnitude.
c
40 continue
if (igap .eq. 0) go to 9000
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j.lt.0) go to 60
c
if (abs(x(j)).lt.abs(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LA') then
c
c X is sorted into increasing order of algebraic.
c
70 continue
if (igap .eq. 0) go to 9000
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (x(j).gt.x(j+igap)) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'LM') then
c
c X is sorted into increasing order of magnitude.
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (abs(x(j)).gt.abs(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call sswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
end if
c
9000 continue
return
c
c %---------------%
c | End of ssesrt |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cnapps.f 0000644 0001750 0001750 00000042206 12277373057 012407 0000000 0000000 c\BeginDoc
c
c\Name: cnapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call cnapps
c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c cmout ARPACK utility routine that prints matrices
c cvout ARPACK utility routine that prints vectors.
c clacpy LAPACK matrix copy routine.
c clanhs LAPACK routine that computes various norms of a matrix.
c clartg LAPACK Givens rotation construction routine.
c claset LAPACK matrix initialization routine.
c slabad LAPACK routine for defining the underflow and overflow
c limits.
c slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another.
c cscal Level 1 BLAS that scales a vector.
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: 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
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine clahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cnapps
& ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
& rzero = 0.0E+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex
& cdum, f, g, h11, h21, r, s, sigma, t
Real
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cgemv, cscal, clacpy, clartg,
& cvout, claset, slabad, cmout, arscnd, ivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& clanhs, slamch, slapy2
external clanhs, slamch, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, aimag, conjg, cmplx, max, min, real
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Real
& cabs1
cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------------%
c
unfl = slamch( 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call claset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call ivout (logfil, 1, jj, ndigit,
& '_napps: shift number.')
call cvout (logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %----------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = clanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(real(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call cvout (logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call ivout (logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call clartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( real( h(j+1,j) ) .lt. rzero .or.
& aimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / slapy2(real(h(j+1,j)),aimag(h(j+1,j)))
call cscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call cscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call cscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = cmplx( real( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = clanhs( '1', kev, h, ldh, workl )
if( real( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call cgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call cgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call ccopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call clacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call ccopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call cscal (n, q(kplusp,kev), resid, 1)
if ( real( h(kev+1,kev) ) .gt. rzero )
& call caxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call cvout (logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call cvout (logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call ivout (logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call cmout (logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %---------------%
c | End of cnapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cstatn.f 0000644 0001750 0001750 00000002305 12277373057 012413 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: statn.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for complex nonsymmetric Arnoldi code. |
c %---------------------------------------------%
subroutine cstatn
c
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
include 'stat.h'
c %-----------------------%
c | Executable Statements |
c %-----------------------%
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
tcaupd = 0.0E+0
tcaup2 = 0.0E+0
tcaitr = 0.0E+0
tceigh = 0.0E+0
tcgets = 0.0E+0
tcapps = 0.0E+0
tcconv = 0.0E+0
titref = 0.0E+0
tgetv0 = 0.0E+0
trvec = 0.0E+0
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
tmvopx = 0.0E+0
tmvbx = 0.0E+0
return
c
c %---------------%
c | End of cstatn |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cneigh.f 0000644 0001750 0001750 00000017711 12277373057 012363 0000000 0000000 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 arscnd 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, arscnd
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 arscnd (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 arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of cneigh |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssgets.f 0000644 0001750 0001750 00000016341 12277373057 012434 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssgets
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call ssgets
c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Real array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Real array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortr ARPACK utility sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
c sswap Level 1 BLAS that swaps the contents of two vectors.
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\Revision history:
c xx/xx/93: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: sgets.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssgets ( ishift, which, kev, np, ritz, bounds, shifts )
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external sswap, scopy, ssortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call ssortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call sswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call sswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call ssortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine ssapps. |
c %-------------------------------------------------------%
c
call ssortr ('SM', .true., np, bounds, ritz)
call scopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_sgets: KEV is')
call ivout (logfil, 1, np, ndigit, '_sgets: NP is')
call svout (logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call svout (logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %---------------%
c | End of ssgets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dstatn.f 0000644 0001750 0001750 00000002710 12277373057 012414 0000000 0000000 c
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for nonsymmetric Arnoldi code. |
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: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2
c
subroutine dstatn
c
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
include 'stat.h'
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
c
tnaupd = 0.0D+0
tnaup2 = 0.0D+0
tnaitr = 0.0D+0
tneigh = 0.0D+0
tngets = 0.0D+0
tnapps = 0.0D+0
tnconv = 0.0D+0
titref = 0.0D+0
tgetv0 = 0.0D+0
trvec = 0.0D+0
c
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
c
tmvopx = 0.0D+0
tmvbx = 0.0D+0
c
return
c
c
c %---------------%
c | End of dstatn |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dnconv.f 0000644 0001750 0001750 00000007765 12277373057 012425 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dnconv
c
c\Description:
c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine.
c
c\Usage:
c call dnconv
c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV )
c
c\Arguments
c N Integer. (INPUT)
c Number of Ritz values to check for convergence.
c
c RITZR, Double precision arrays of length N. (INPUT)
c RITZI Real and imaginary parts of the Ritz values to be checked
c for convergence.
c BOUNDS Double precision array of length N. (INPUT)
c Ritz estimates for the Ritz values in RITZR and RITZI.
c
c TOL Double precision scalar. (INPUT)
c Desired backward error for a Ritz value to be considered
c "converged".
c
c NCONV Integer scalar. (OUTPUT)
c Number of "converged" Ritz values.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c dlamch LAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dnconv (n, ritzr, ritzi, bounds, tol, nconv)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, nconv
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
Double precision
& ritzr(n), ritzi(n), bounds(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i
Double precision
& temp, eps23
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2, dlamch
external dlapy2, dlamch
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------------------%
c | Convergence test: unlike in the symmetric code, I am not |
c | using things like refined error bounds and gap condition |
c | because I don't know the exact equivalent concept. |
c | |
c | Instead the i-th Ritz value is considered "converged" when: |
c | |
c | bounds(i) .le. ( TOL * | ritz | ) |
c | |
c | for some appropriate choice of norm. |
c %-------------------------------------------------------------%
c
call arscnd (t0)
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = dlamch('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0)
c
nconv = 0
do 20 i = 1, n
temp = max( eps23, dlapy2( ritzr(i), ritzi(i) ) )
if (bounds(i) .le. tol*temp) nconv = nconv + 1
20 continue
c
call arscnd (t1)
tnconv = tnconv + (t1 - t0)
c
return
c
c %---------------%
c | End of dnconv |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cngets.f 0000644 0001750 0001750 00000012673 12277373057 012413 0000000 0000000 c\BeginDoc
c
c\Name: cngets
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call cngets
c ( ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\Routines called:
c csortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c cvout ARPACK utility routine that prints vectors.
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: ngets.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cngets ( ishift, which, kev, np, ritz, bounds)
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external cvout, csortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call csortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine cnapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call csortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
call cvout (logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call cvout (logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %---------------%
c | End of cngets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dneupd.f 0000644 0001750 0001750 00000126615 12277373057 012411 0000000 0000000 c\BeginDoc
c
c\Name: dneupd
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 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 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
c\Usage:
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 )
c
c\Arguments:
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 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 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 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
c **** The remaining arguments MUST be the same as for the ****
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
c Three of these parameters (V, WORKL, INFO) are also output parameters:
c
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
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+3*ncv) contains information obtained in
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 -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
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 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
c the same space. Please notify the authors if this error
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 = -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 = -9: Error return from calculation of eigenvectors.
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 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
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 a matrix.
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 factored form.
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
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 Set RVEC = .true. and HOWMNY = 'A', and
c compute
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 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 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
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
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)
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj , nconv2
logical reord
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
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2 , dnrm2 , dlamch , ddot
external dlapy2 , dnrm2 , dlamch , ddot
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = dlamch ('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
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 | 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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
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
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, 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 | 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. nconv) reord = .true.
endif
11 continue
c
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, 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 | 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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call dvout (logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call dvout (logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
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,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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),
& nconv2 , conds ,
& sep , workl(ihbds) ,
& ncv , iwork ,
& 1 , ierr)
c
if (nconv2 .lt. nconv) then
nconv = nconv2
end if
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call dvout (logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
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')
end if
end if
c
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
c | if a spectral transformation was not used. |
c %----------------------------------------------------%
c
if (type .eq. 'REGULR') then
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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 dlacpy ('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones |
c %---------------------------------------------------%
c
if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
call dscal (nconv, -one, workl(iuptri+j-1), ldq)
call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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 | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 )
call dscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
c
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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 )
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call dgemv ('T', ncv, nconv, one, workl(invsub),
& ldq, workl(ihbds), 1, zero, workev, 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = dlapy2 (workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
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')
if (msglvl .gt. 3) then
call dmout (logfil, ncv, ncv, workl(invsub), ldq,
& ndigit, '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call dcopy (nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call dtrmm ('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed DNAUPD into DR and DI |
c %------------------------------------------------------%
c
call dcopy (nconv, workl(ritzr), 1, dr, 1)
call dcopy (nconv, workl(ritzi), 1, di, 1)
call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1)
call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1)
call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = dlapy2 ( workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
temp = dlapy2 ( workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(iheigr+k-1) = workl(iheigr+k-1)/temp/temp
& + sigmar
workl(iheigi+k-1) = -workl(iheigi+k-1)/temp/temp
& + sigmai
80 continue
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
end if
c
end if
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,
& '_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,
& '_neupd: Imag parts of converged Ritz values.')
call dvout (logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
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) )
workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigr+j-1) +
& workl(invsub+j*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call dger (n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %---------------%
c | End of DNEUPD |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dstqrb.f 0000644 0001750 0001750 00000040624 12277373057 012424 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dstqrb
c
c\Description:
c Computes all eigenvalues and the last component of the eigenvectors
c of a symmetric tridiagonal matrix using the implicit QL or QR method.
c
c This is mostly a modification of the LAPACK routine dsteqr.
c See Remarks.
c
c\Usage:
c call dstqrb
c ( N, D, E, Z, WORK, INFO )
c
c\Arguments
c N Integer. (INPUT)
c The number of rows and columns in the matrix. N >= 0.
c
c D Double precision array, dimension (N). (INPUT/OUTPUT)
c On entry, D contains the diagonal elements of the
c tridiagonal matrix.
c On exit, D contains the eigenvalues, in ascending order.
c If an error exit is made, the eigenvalues are correct
c for indices 1,2,...,INFO-1, but they are unordered and
c may not be the smallest eigenvalues of the matrix.
c
c E Double precision array, dimension (N-1). (INPUT/OUTPUT)
c On entry, E contains the subdiagonal elements of the
c tridiagonal matrix in positions 1 through N-1.
c On exit, E has been destroyed.
c
c Z Double precision array, dimension (N). (OUTPUT)
c On exit, Z contains the last row of the orthonormal
c eigenvector matrix of the symmetric tridiagonal matrix.
c If an error exit is made, Z contains the last row of the
c eigenvector matrix associated with the stored eigenvalues.
c
c WORK Double precision array, dimension (max(1,2*N-2)). (WORKSPACE)
c Workspace used in accumulating the transformation for
c computing the last components of the eigenvectors.
c
c INFO Integer. (OUTPUT)
c = 0: normal return.
c < 0: if INFO = -i, the i-th argument had an illegal value.
c > 0: if INFO = +i, the i-th eigenvalue has not converged
c after a total of 30*N iterations.
c
c\Remarks
c 1. None.
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another.
c dswap Level 1 BLAS that swaps the contents of two vectors.
c lsame LAPACK character comparison routine.
c dlae2 LAPACK routine that computes the eigenvalues of a 2-by-2
c symmetric matrix.
c dlaev2 LAPACK routine that eigendecomposition of a 2-by-2 symmetric
c matrix.
c dlamch LAPACK routine that determines machine constants.
c dlanst LAPACK routine that computes the norm of a matrix.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dlartg LAPACK Givens rotation construction routine.
c dlascl LAPACK routine for careful scaling of a matrix.
c dlaset LAPACK matrix initialization routine.
c dlasr LAPACK routine that applies an orthogonal transformation to
c a matrix.
c dlasrt LAPACK sorting routine.
c dsteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a symmetric tridiagonal matrix.
c xerbla LAPACK error handler routine.
c
c\Authors
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: stqrb.F SID: 2.5 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c 1. Starting with version 2.5, this routine is a modified version
c of LAPACK version 2.0 subroutine SSTEQR. No lines are deleted,
c only commeted out and new lines inserted.
c All lines commented out have "c$$$" at the beginning.
c Note that the LAPACK version 1.0 subroutine SSTEQR contained
c bugs.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dstqrb ( n, d, e, z, work, info )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer info, n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& d( n ), e( n-1 ), z( n ), work( 2*n-2 )
c
c .. parameters ..
Double precision
& zero, one, two, three
parameter ( zero = 0.0D+0, one = 1.0D+0,
& two = 2.0D+0, three = 3.0D+0 )
integer maxit
parameter ( maxit = 30 )
c ..
c .. local scalars ..
integer i, icompz, ii, iscale, j, jtot, k, l, l1, lend,
& lendm1, lendp1, lendsv, lm1, lsv, m, mm, mm1,
& nm1, nmaxit
Double precision
& anorm, b, c, eps, eps2, f, g, p, r, rt1, rt2,
& s, safmax, safmin, ssfmax, ssfmin, tst
c ..
c .. external functions ..
logical lsame
Double precision
& dlamch, dlanst, dlapy2
external lsame, dlamch, dlanst, dlapy2
c ..
c .. external subroutines ..
external dlae2, dlaev2, dlartg, dlascl, dlaset, dlasr,
& dlasrt, dswap, xerbla
c ..
c .. intrinsic functions ..
intrinsic abs, max, sign, sqrt
c ..
c .. executable statements ..
c
c test the input parameters.
c
info = 0
c
c$$$ IF( LSAME( COMPZ, 'N' ) ) THEN
c$$$ ICOMPZ = 0
c$$$ ELSE IF( LSAME( COMPZ, 'V' ) ) THEN
c$$$ ICOMPZ = 1
c$$$ ELSE IF( LSAME( COMPZ, 'I' ) ) THEN
c$$$ ICOMPZ = 2
c$$$ ELSE
c$$$ ICOMPZ = -1
c$$$ END IF
c$$$ IF( ICOMPZ.LT.0 ) THEN
c$$$ INFO = -1
c$$$ ELSE IF( N.LT.0 ) THEN
c$$$ INFO = -2
c$$$ ELSE IF( ( LDZ.LT.1 ) .OR. ( ICOMPZ.GT.0 .AND. LDZ.LT.MAX( 1,
c$$$ $ N ) ) ) THEN
c$$$ INFO = -6
c$$$ END IF
c$$$ IF( INFO.NE.0 ) THEN
c$$$ CALL XERBLA( 'SSTEQR', -INFO )
c$$$ RETURN
c$$$ END IF
c
c *** New starting with version 2.5 ***
c
icompz = 2
c *************************************
c
c quick return if possible
c
if( n.eq.0 )
$ return
c
if( n.eq.1 ) then
if( icompz.eq.2 ) z( 1 ) = one
return
end if
c
c determine the unit roundoff and over/underflow thresholds.
c
eps = dlamch( 'e' )
eps2 = eps**2
safmin = dlamch( 's' )
safmax = one / safmin
ssfmax = sqrt( safmax ) / three
ssfmin = sqrt( safmin ) / eps2
c
c compute the eigenvalues and eigenvectors of the tridiagonal
c matrix.
c
c$$ if( icompz.eq.2 )
c$$$ $ call dlaset( 'full', n, n, zero, one, z, ldz )
c
c *** New starting with version 2.5 ***
c
if ( icompz .eq. 2 ) then
do 5 j = 1, n-1
z(j) = zero
5 continue
z( n ) = one
end if
c *************************************
c
nmaxit = n*maxit
jtot = 0
c
c determine where the matrix splits and choose ql or qr iteration
c for each block, according to whether top or bottom diagonal
c element is smaller.
c
l1 = 1
nm1 = n - 1
c
10 continue
if( l1.gt.n )
$ go to 160
if( l1.gt.1 )
$ e( l1-1 ) = zero
if( l1.le.nm1 ) then
do 20 m = l1, nm1
tst = abs( e( m ) )
if( tst.eq.zero )
$ go to 30
if( tst.le.( sqrt( abs( d( m ) ) )*sqrt( abs( d( m+
$ 1 ) ) ) )*eps ) then
e( m ) = zero
go to 30
end if
20 continue
end if
m = n
c
30 continue
l = l1
lsv = l
lend = m
lendsv = lend
l1 = m + 1
if( lend.eq.l )
$ go to 10
c
c scale submatrix in rows and columns l to lend
c
anorm = dlanst( 'i', lend-l+1, d( l ), e( l ) )
iscale = 0
if( anorm.eq.zero )
$ go to 10
if( anorm.gt.ssfmax ) then
iscale = 1
call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l+1, 1, d( l ), n,
$ info )
call dlascl( 'g', 0, 0, anorm, ssfmax, lend-l, 1, e( l ), n,
$ info )
else if( anorm.lt.ssfmin ) then
iscale = 2
call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l+1, 1, d( l ), n,
$ info )
call dlascl( 'g', 0, 0, anorm, ssfmin, lend-l, 1, e( l ), n,
$ info )
end if
c
c choose between ql and qr iteration
c
if( abs( d( lend ) ).lt.abs( d( l ) ) ) then
lend = lsv
l = lendsv
end if
c
if( lend.gt.l ) then
c
c ql iteration
c
c look for small subdiagonal element.
c
40 continue
if( l.ne.lend ) then
lendm1 = lend - 1
do 50 m = l, lendm1
tst = abs( e( m ) )**2
if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m+1 ) )+
$ safmin )go to 60
50 continue
end if
c
m = lend
c
60 continue
if( m.lt.lend )
$ e( m ) = zero
p = d( l )
if( m.eq.l )
$ go to 80
c
c if remaining matrix is 2-by-2, use dlae2 or dlaev2
c to compute its eigensystem.
c
if( m.eq.l+1 ) then
if( icompz.gt.0 ) then
call dlaev2( d( l ), e( l ), d( l+1 ), rt1, rt2, c, s )
work( l ) = c
work( n-1+l ) = s
c$$$ call dlasr( 'r', 'v', 'b', n, 2, work( l ),
c$$$ $ work( n-1+l ), z( 1, l ), ldz )
c
c *** New starting with version 2.5 ***
c
tst = z(l+1)
z(l+1) = c*tst - s*z(l)
z(l) = s*tst + c*z(l)
c *************************************
else
call dlae2( d( l ), e( l ), d( l+1 ), rt1, rt2 )
end if
d( l ) = rt1
d( l+1 ) = rt2
e( l ) = zero
l = l + 2
if( l.le.lend )
$ go to 40
go to 140
end if
c
if( jtot.eq.nmaxit )
$ go to 140
jtot = jtot + 1
c
c form shift.
c
g = ( d( l+1 )-p ) / ( two*e( l ) )
r = dlapy2( g, one )
g = d( m ) - p + ( e( l ) / ( g+sign( r, g ) ) )
c
s = one
c = one
p = zero
c
c inner loop
c
mm1 = m - 1
do 70 i = mm1, l, -1
f = s*e( i )
b = c*e( i )
call dlartg( g, f, c, s, r )
if( i.ne.m-1 )
$ e( i+1 ) = r
g = d( i+1 ) - p
r = ( d( i )-g )*s + two*c*b
p = s*r
d( i+1 ) = g + p
g = c*r - b
c
c if eigenvectors are desired, then save rotations.
c
if( icompz.gt.0 ) then
work( i ) = c
work( n-1+i ) = -s
end if
c
70 continue
c
c if eigenvectors are desired, then apply saved rotations.
c
if( icompz.gt.0 ) then
mm = m - l + 1
c$$$ call dlasr( 'r', 'v', 'b', n, mm, work( l ), work( n-1+l ),
c$$$ $ z( 1, l ), ldz )
c
c *** New starting with version 2.5 ***
c
call dlasr( 'r', 'v', 'b', 1, mm, work( l ),
& work( n-1+l ), z( l ), 1 )
c *************************************
end if
c
d( l ) = d( l ) - p
e( l ) = g
go to 40
c
c eigenvalue found.
c
80 continue
d( l ) = p
c
l = l + 1
if( l.le.lend )
$ go to 40
go to 140
c
else
c
c qr iteration
c
c look for small superdiagonal element.
c
90 continue
if( l.ne.lend ) then
lendp1 = lend + 1
do 100 m = l, lendp1, -1
tst = abs( e( m-1 ) )**2
if( tst.le.( eps2*abs( d( m ) ) )*abs( d( m-1 ) )+
$ safmin )go to 110
100 continue
end if
c
m = lend
c
110 continue
if( m.gt.lend )
$ e( m-1 ) = zero
p = d( l )
if( m.eq.l )
$ go to 130
c
c if remaining matrix is 2-by-2, use dlae2 or dlaev2
c to compute its eigensystem.
c
if( m.eq.l-1 ) then
if( icompz.gt.0 ) then
call dlaev2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2, c, s )
c$$$ work( m ) = c
c$$$ work( n-1+m ) = s
c$$$ call dlasr( 'r', 'v', 'f', n, 2, work( m ),
c$$$ $ work( n-1+m ), z( 1, l-1 ), ldz )
c
c *** New starting with version 2.5 ***
c
tst = z(l)
z(l) = c*tst - s*z(l-1)
z(l-1) = s*tst + c*z(l-1)
c *************************************
else
call dlae2( d( l-1 ), e( l-1 ), d( l ), rt1, rt2 )
end if
d( l-1 ) = rt1
d( l ) = rt2
e( l-1 ) = zero
l = l - 2
if( l.ge.lend )
$ go to 90
go to 140
end if
c
if( jtot.eq.nmaxit )
$ go to 140
jtot = jtot + 1
c
c form shift.
c
g = ( d( l-1 )-p ) / ( two*e( l-1 ) )
r = dlapy2( g, one )
g = d( m ) - p + ( e( l-1 ) / ( g+sign( r, g ) ) )
c
s = one
c = one
p = zero
c
c inner loop
c
lm1 = l - 1
do 120 i = m, lm1
f = s*e( i )
b = c*e( i )
call dlartg( g, f, c, s, r )
if( i.ne.m )
$ e( i-1 ) = r
g = d( i ) - p
r = ( d( i+1 )-g )*s + two*c*b
p = s*r
d( i ) = g + p
g = c*r - b
c
c if eigenvectors are desired, then save rotations.
c
if( icompz.gt.0 ) then
work( i ) = c
work( n-1+i ) = s
end if
c
120 continue
c
c if eigenvectors are desired, then apply saved rotations.
c
if( icompz.gt.0 ) then
mm = l - m + 1
c$$$ call dlasr( 'r', 'v', 'f', n, mm, work( m ), work( n-1+m ),
c$$$ $ z( 1, m ), ldz )
c
c *** New starting with version 2.5 ***
c
call dlasr( 'r', 'v', 'f', 1, mm, work( m ), work( n-1+m ),
& z( m ), 1 )
c *************************************
end if
c
d( l ) = d( l ) - p
e( lm1 ) = g
go to 90
c
c eigenvalue found.
c
130 continue
d( l ) = p
c
l = l - 1
if( l.ge.lend )
$ go to 90
go to 140
c
end if
c
c undo scaling if necessary
c
140 continue
if( iscale.eq.1 ) then
call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv+1, 1,
$ d( lsv ), n, info )
call dlascl( 'g', 0, 0, ssfmax, anorm, lendsv-lsv, 1, e( lsv ),
$ n, info )
else if( iscale.eq.2 ) then
call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv+1, 1,
$ d( lsv ), n, info )
call dlascl( 'g', 0, 0, ssfmin, anorm, lendsv-lsv, 1, e( lsv ),
$ n, info )
end if
c
c check for no convergence to an eigenvalue after a total
c of n*maxit iterations.
c
if( jtot.lt.nmaxit )
$ go to 10
do 150 i = 1, n - 1
if( e( i ).ne.zero )
$ info = info + 1
150 continue
go to 190
c
c order eigenvalues and eigenvectors.
c
160 continue
if( icompz.eq.0 ) then
c
c use quick sort
c
call dlasrt( 'i', n, d, info )
c
else
c
c use selection sort to minimize swaps of eigenvectors
c
do 180 ii = 2, n
i = ii - 1
k = i
p = d( i )
do 170 j = ii, n
if( d( j ).lt.p ) then
k = j
p = d( j )
end if
170 continue
if( k.ne.i ) then
d( k ) = d( i )
d( i ) = p
c$$$ call dswap( n, z( 1, i ), 1, z( 1, k ), 1 )
c *** New starting with version 2.5 ***
c
p = z(k)
z(k) = z(i)
z(i) = p
c *************************************
end if
180 continue
end if
c
190 continue
return
c
c %---------------%
c | End of dstqrb |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sgetv0.f 0000644 0001750 0001750 00000031466 12277373057 012341 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: sgetv0
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call sgetv0
c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, IERR )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to sgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that sgetv0 is called.
c It should be set to 1 on the initial call to sgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Real N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Real work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine for vector output.
c slarnv LAPACK routine for generating a random vector.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
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: getv0.F SID: 2.7 DATE OF SID: 04/07/99 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine sgetv0
& ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, 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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& resid(n), v(ldv,j), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Real
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external slarnv, svout, scopy, sgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, snrm2
external sdot, snrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call slarnv (idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call scopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
end if
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm0 = sdot (n, resid, 1, workd, 1)
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = snrm2(n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call sgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workd(n+1), 1)
call sgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = snrm2(n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call svout (logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call svout (logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call svout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 3) then
call svout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of sgetv0 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/snaitr.f 0000644 0001750 0001750 00000073467 12277373057 012440 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: snaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in snaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call snaitr
c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See snaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c sgetv0 ARPACK routine to generate the initial vector.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c slabad LAPACK routine that computes machine constants.
c slamch LAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c slanhs LAPACK routine that computes various norms of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in snaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine snaitr
& (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, sgetv0, slabad,
& svout, smout, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, snrm2, slanhs, slamch
external sdot, snrm2, slanhs, slamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------%
c
unfl = slamch( 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | sgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call svout (logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
wnorm = sdot (n, resid, 1, workd(ipj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = snrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd(ipj), 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = snrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call svout (logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call svout (logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
call saxpy (j, one, workd(irj), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = snrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call svout (logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call smout (logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of snaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/Makefile.in 0000644 0001750 0001750 00000041723 12277667632 013031 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = SRC
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libarpacksrc_la_LIBADD =
am_libarpacksrc_la_OBJECTS = sgetv0.lo slaqrb.lo sstqrb.lo ssortc.lo \
ssortr.lo sstatn.lo sstats.lo snaitr.lo snapps.lo snaup2.lo \
snaupd.lo snconv.lo sneigh.lo sngets.lo ssaitr.lo ssapps.lo \
ssaup2.lo ssaupd.lo ssconv.lo sseigt.lo ssgets.lo sneupd.lo \
sseupd.lo ssesrt.lo dgetv0.lo dlaqrb.lo dstqrb.lo dsortc.lo \
dsortr.lo dstatn.lo dstats.lo dnaitr.lo dnapps.lo dnaup2.lo \
dnaupd.lo dnconv.lo dneigh.lo dngets.lo dsaitr.lo dsapps.lo \
dsaup2.lo dsaupd.lo dsconv.lo dseigt.lo dsgets.lo dneupd.lo \
dseupd.lo dsesrt.lo cnaitr.lo cnapps.lo cnaup2.lo cnaupd.lo \
cneigh.lo cneupd.lo cngets.lo cgetv0.lo csortc.lo cstatn.lo \
znaitr.lo znapps.lo znaup2.lo znaupd.lo zneigh.lo zneupd.lo \
zngets.lo zgetv0.lo zsortc.lo zstatn.lo
libarpacksrc_la_OBJECTS = $(am_libarpacksrc_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libarpacksrc_la_SOURCES)
DIST_SOURCES = $(libarpacksrc_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libarpacksrc.la
libarpacksrc_la_SOURCES = \
sgetv0.f slaqrb.f sstqrb.f ssortc.f ssortr.f sstatn.f sstats.f \
snaitr.f snapps.f snaup2.f snaupd.f snconv.f sneigh.f sngets.f \
ssaitr.f ssapps.f ssaup2.f ssaupd.f ssconv.f sseigt.f ssgets.f \
sneupd.f sseupd.f ssesrt.f \
dgetv0.f dlaqrb.f dstqrb.f dsortc.f dsortr.f dstatn.f dstats.f \
dnaitr.f dnapps.f dnaup2.f dnaupd.f dnconv.f dneigh.f dngets.f \
dsaitr.f dsapps.f dsaup2.f dsaupd.f dsconv.f dseigt.f dsgets.f \
dneupd.f dseupd.f dsesrt.f \
cnaitr.f cnapps.f cnaup2.f cnaupd.f cneigh.f cneupd.f cngets.f \
cgetv0.f csortc.f cstatn.f \
znaitr.f znapps.f znaup2.f znaupd.f zneigh.f zneupd.f zngets.f \
zgetv0.f zsortc.f zstatn.f
EXTRA_DIST = debug.h stat.h version.h
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign SRC/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign SRC/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libarpacksrc.la: $(libarpacksrc_la_OBJECTS) $(libarpacksrc_la_DEPENDENCIES) $(EXTRA_libarpacksrc_la_DEPENDENCIES)
$(AM_V_F77LD)$(F77LINK) $(libarpacksrc_la_OBJECTS) $(libarpacksrc_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/SRC/version.h 0000644 0001750 0001750 00000002346 12277373057 012613 0000000 0000000 /*
In the current version, the parameter KAPPA in the Kahan's test
for orthogonality is set to 0.717, the same as used by Gragg & Reichel.
However computational experience indicates that this is a little too
strict and will frequently force reorthogonalization when it is not
necessary to do so.
Also the "moving boundary" idea is not currently activated in the nonsymmetric
code since it is not conclusive that it's the right thing to do all the time.
Requires further investigation.
As of 02/01/93 Richard Lehoucq assumes software control of the codes from
Phuong Vu. On 03/01/93 all the *.F files were migrated SCCS. The 1.1 version
of codes are those received from Phuong Vu. The frozen version of 07/08/92
is now considered version 1.1.
Version 2.1 contains two new symmetric routines, sesrt and seupd.
Changes as well as bug fixes for version 1.1 codes that were only corrected
for programming bugs are version 1.2. These 1.2 versions will also be in version 2.1.
Subroutine [d,s]saupd now requires slightly more workspace. See [d,s]saupd for the
details.
\SCCS Information: @(#)
FILE: version.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
*/
#define VERSION_NUMBER ' 2.1'
#define VERSION_DATE ' 11/15/95'
arpack-ng-3.1.5/SRC/dstats.f 0000644 0001750 0001750 00000002216 12277373057 012422 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for symmetric Arnoldi code. |
c %---------------------------------------------%
subroutine dstats
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
include 'stat.h'
c %-----------------------%
c | Executable Statements |
c %-----------------------%
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
tsaupd = 0.0D+0
tsaup2 = 0.0D+0
tsaitr = 0.0D+0
tseigt = 0.0D+0
tsgets = 0.0D+0
tsapps = 0.0D+0
tsconv = 0.0D+0
titref = 0.0D+0
tgetv0 = 0.0D+0
trvec = 0.0D+0
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
tmvopx = 0.0D+0
tmvbx = 0.0D+0
return
c
c End of dstats
c
end
arpack-ng-3.1.5/SRC/ssaitr.f 0000644 0001750 0001750 00000073727 12277373057 012444 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in ssaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call ssaitr
c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See ssaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c sgetv0 ARPACK routine to generate the initial vector.
c ivout ARPACK utility routine that prints integers.
c smout ARPACK utility routine that prints matrices.
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
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\Revision history:
c xx/xx/93: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in ssaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssaitr
& (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& infol, jj
Real
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, sgetv0, svout, smout,
& slascl, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, snrm2, slamch
external sdot, snrm2, slamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = slamch('safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | sgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call svout (logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call sgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
wnorm = sdot (n, resid, 1, workd(ivj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
wnorm = sdot (n, resid, 1, workd(ipj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = snrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call sgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workd(irj), 1)
else if (mode .eq. 2) then
call sgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workd(irj), 1)
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv('N', n, j, -one, v, ldv, workd(irj), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workd(irj + j - 1)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd(ipj), 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = snrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call svout (logfil, 2, xtemp, ndigit,
& '_saitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workd(irj + j - 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = snrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call svout (logfil, 2, xtemp, ndigit,
& '_saitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call sscal(n, -one, v(1,j+1), 1)
else
call sscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call svout (logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call svout (logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of ssaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dneigh.f 0000644 0001750 0001750 00000024241 12277373057 012360 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dneigh
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 dneigh
c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
c
c\Arguments
c RNORM Double precision 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 Double precision 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 RITZR, Double precision arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Double precision 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 Double precision 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 IERR Integer. (OUTPUT)
c Error exit flag from dlaqrb or dtrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dlaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices
c dvout ARPACK utility routine that prints vectors.
c dlacpy LAPACK matrix copy routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dtrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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
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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, 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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Double precision
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dlacpy, dlaqrb, dtrevc, dvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call dmout (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 | dlaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call dlacpy ('All', n, n, h, ldh, workl, n)
call dlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call dvout (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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | dtrevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = dnrm2( n, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = dlapy2( dnrm2( n, q(1,i), 1 ),
& dnrm2( n, q(1,i+1), 1 ) )
call dscal ( n, one / temp, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call dvout (logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call dvout (logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call dvout (logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call dvout (logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of dneigh |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/csortc.f 0000644 0001750 0001750 00000017575 12277373057 012433 0000000 0000000 c\BeginDoc
c
c\Name: csortc
c
c\Description:
c Sorts the Complex array in X into the order
c specified by WHICH and optionally applies the permutation to the
c Real array Y.
c
c\Usage:
c call csortc
c ( WHICH, APPLY, N, X, Y )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> sort X into increasing order of magnitude.
c 'SM' -> sort X into decreasing order of magnitude.
c 'LR' -> sort X with real(X) in increasing algebraic order
c 'SR' -> sort X with real(X) in decreasing algebraic order
c 'LI' -> sort X with imag(X) in increasing algebraic order
c 'SI' -> sort X with imag(X) in decreasing algebraic order
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to array Y.
c APPLY = .FALSE. -> do not apply the sorted order to array Y.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c X Complex array of length N. (INPUT/OUTPUT)
c This is the array to be sorted.
c
c Y Complex array of length N. (INPUT/OUTPUT)
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines called:
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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 Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortc.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine csortc (which, apply, n, x, y)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& x(0:n-1), y(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Complex
& temp
Real
& temp1, temp2
c
c %--------------------%
c | External functions |
c %--------------------%
c
Real
& slapy2
c
c %--------------------%
c | Intrinsic Functions |
c %--------------------%
Intrinsic
& real, aimag
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'LM') then
c
c %--------------------------------------------%
c | Sort X into increasing order of magnitude. |
c %--------------------------------------------%
c
10 continue
if (igap .eq. 0) go to 9000
c
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
temp1 = slapy2(real(x(j)),aimag(x(j)))
temp2 = slapy2(real(x(j+igap)),aimag(x(j+igap)))
c
if (temp1.gt.temp2) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 30
end if
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c %--------------------------------------------%
c | Sort X into decreasing order of magnitude. |
c %--------------------------------------------%
c
40 continue
if (igap .eq. 0) go to 9000
c
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j .lt. 0) go to 60
c
temp1 = slapy2(real(x(j)),aimag(x(j)))
temp2 = slapy2(real(x(j+igap)),aimag(x(j+igap)))
c
if (temp1.lt.temp2) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LR') then
c
c %------------------------------------------------%
c | Sort XREAL into increasing order of algebraic. |
c %------------------------------------------------%
c
70 continue
if (igap .eq. 0) go to 9000
c
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (real(x(j)).gt.real(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'SR') then
c
c %------------------------------------------------%
c | Sort XREAL into decreasing order of algebraic. |
c %------------------------------------------------%
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (real(x(j)).lt.real(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
c
else if (which .eq. 'LI') then
c
c %--------------------------------------------%
c | Sort XIMAG into increasing algebraic order |
c %--------------------------------------------%
c
130 continue
if (igap .eq. 0) go to 9000
do 150 i = igap, n-1
j = i-igap
140 continue
c
if (j.lt.0) go to 150
c
if (aimag(x(j)).gt.aimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 150
endif
j = j-igap
go to 140
150 continue
igap = igap / 2
go to 130
c
else if (which .eq. 'SI') then
c
c %---------------------------------------------%
c | Sort XIMAG into decreasing algebraic order |
c %---------------------------------------------%
c
160 continue
if (igap .eq. 0) go to 9000
do 180 i = igap, n-1
j = i-igap
170 continue
c
if (j.lt.0) go to 180
c
if (aimag(x(j)).lt.aimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 180
endif
j = j-igap
go to 170
180 continue
igap = igap / 2
go to 160
end if
c
9000 continue
return
c
c %---------------%
c | End of csortc |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsaitr.f 0000644 0001750 0001750 00000074133 12277373057 012415 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in dsaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call dsaitr
c ( IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See dsaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dgetv0 ARPACK routine to generate the initial vector.
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 dlamch LAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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
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\Revision history:
c xx/xx/93: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: saitr.F SID: 2.6 DATE OF SID: 8/28/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in dsaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsaitr
& (ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& infol, jj
Double precision
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, dgetv0, dvout, dmout,
& dlascl, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, dnrm2, dlamch
external ddot, dnrm2, dlamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = dlamch('safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | dgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call dvout (logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
wnorm = ddot (n, resid, 1, workd(ivj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
wnorm = ddot (n, resid, 1, workd(ipj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = dnrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workd(irj), 1)
else if (mode .eq. 2) then
call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workd(irj), 1)
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv('N', n, j, -one, v, ldv, workd(irj), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workd(irj + j - 1)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd(ipj), 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = dnrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call dvout (logfil, 2, xtemp, ndigit,
& '_saitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workd(irj + j - 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = dnrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_saitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call dvout (logfil, 2, xtemp, ndigit,
& '_saitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call dscal(n, -one, v(1,j+1), 1)
else
call dscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call dvout (logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call dvout (logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of dsaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsaupd.f 0000644 0001750 0001750 00000070262 12277373057 012406 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsaupd
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
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 following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
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 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 WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c (If Mode = 2 see remark 5 below)
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
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 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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 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 of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 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 -------------------------------------------------------------
c
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 See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 = -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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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
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
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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 Arnoldi Iteration.
c dstats ARPACK routine that initialize timing and other statistics
c variables.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dlamch LAPACK routine that determines machine constants.
c
c\Authors
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\Revision history:
c 12/15/93: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: saupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dsaup2 , dvout , ivout, arscnd, dstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch
external dlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = dlamch ('EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within dsaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_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,
& '_saupd: final Ritz values')
call dvout (logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.4' , 19x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of dsaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/znaitr.f 0000644 0001750 0001750 00000074633 12277373057 012443 0000000 0000000 c\BeginDoc
c
c\Name: znaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in znaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call znaitr
c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See znaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex*16 N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c zgetv0 ARPACK routine to generate the initial vector.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c zmout ARPACK utility routine that prints matrices
c zvout ARPACK utility routine that prints vectors.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlascl LAPACK routine for careful scaling of a matrix.
c dlabad LAPACK routine for defining the underflow and overflow
c limits.
c dlamch LAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
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 zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 Level 1 BLAS that computes the norm of a vector.
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: naitr.F SID: 2.3 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in znaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine znaitr
& (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone, rzero
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
& rone = 1.0D+0, rzero = 0.0D+0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex*16
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zscal, zdscal, zgemv, zgetv0,
& dlabad, zvout, zmout, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
Double precision
& dlamch, dznrm2, zlanhs, dlapy2
external zdotc, dznrm2, zlanhs, dlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------%
c
unfl = dlamch( 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | zgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call dvout (logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call zgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call zcopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call zdscal (n, temp1, v(1,j), 1)
call zdscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine zlascl |
c %-----------------------------------------%
c
call zlascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call zlascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call zcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call zcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = dznrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = dcmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call dvout (logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call zvout (logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
call zaxpy (j, one, workd(irj), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = dznrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call dvout (logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %--------------------------------------------%
c
tst1 = dlapy2(dble(h(i,i)),dimag(h(i,i)))
& + dlapy2(dble(h(i+1,i+1)), dimag(h(i+1,i+1)))
if( tst1.eq.dble(zero) )
& tst1 = zlanhs( '1', k+np, h, ldh, workd(n+1) )
if( dlapy2(dble(h(i+1,i)),dimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call zmout (logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of znaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cnaupd.f 0000644 0001750 0001750 00000066177 12277373057 012412 0000000 0000000 c\BeginDoc
c
c\Name: cnaupd
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then ssaupd or snaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c cnaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x.
c ===> OP = A and B = I.
c
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 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call cnaupd
c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to cnaupd. 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 cnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 auxiliary subroutine slamch).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below.)
c
c V Complex array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of cnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by cneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 cneupd if RVEC = .TRUE. See Remark 2 below.
c
c -------------------------------------------------------------
c
c WORKD Complex 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Real work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine cneupd.
c
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 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 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
c 4. At present there is no a-priori analysis to guide the selection
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c cnaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c cstatn ARPACK routine that initializes the timing variables.
c ivout ARPACK utility routine that prints integers.
c cvout ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c slamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cnaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Real
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0E+0, 0.0E+0) , zero = (0.0E+0, 0.0E+0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external cnaup2, cvout, ivout, arscnd, cstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch
external slamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call cstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0E+0 ) tol = slamch('EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine cneigh called |
c | by cnaup2. Subroutine cneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call cnaup2
& ( 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within cnaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call cvout (logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call cvout (logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.3' , 21x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of cnaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsapps.f 0000644 0001750 0001750 00000044122 12277373057 012414 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call dsapps
c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Double precision array of length NP. (INPUT)
c The shifts to be applied.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dlamch LAPACK routine that determines machine constants.
c dlartg LAPACK Givens rotation construction routine.
c dlacpy LAPACK matrix copy routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector.
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\Revision history:
c 12/16/93: Version ' 2.4'
c
c\SCCS Information: @(#)
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
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsapps
& ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Double precision
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, dvout,
& ivout, arscnd, dgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch
external dlamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = dlamch('Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call dvout (logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call dscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call dvout (logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call dvout (logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call dvout (logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call dvout (logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call dvout (logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of dsapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/slaqrb.f 0000644 0001750 0001750 00000043644 12277373057 012416 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: slaqrb
c
c\Description:
c Compute the eigenvalues and the Schur decomposition of an upper
c Hessenberg submatrix in rows and columns ILO to IHI. Only the
c last component of the Schur vectors are computed.
c
c This is mostly a modification of the LAPACK routine slahqr.
c
c\Usage:
c call slaqrb
c ( WANTT, N, ILO, IHI, H, LDH, WR, WI, Z, INFO )
c
c\Arguments
c WANTT Logical variable. (INPUT)
c = .TRUE. : the full Schur form T is required;
c = .FALSE.: only eigenvalues are required.
c
c N Integer. (INPUT)
c The order of the matrix H. N >= 0.
c
c ILO Integer. (INPUT)
c IHI Integer. (INPUT)
c It is assumed that H is already upper quasi-triangular in
c rows and columns IHI+1:N, and that H(ILO,ILO-1) = 0 (unless
c ILO = 1). SLAQRB works primarily with the Hessenberg
c submatrix in rows and columns ILO to IHI, but applies
c transformations to all of H if WANTT is .TRUE..
c 1 <= ILO <= max(1,IHI); IHI <= N.
c
c H Real array, dimension (LDH,N). (INPUT/OUTPUT)
c On entry, the upper Hessenberg matrix H.
c On exit, if WANTT is .TRUE., H is upper quasi-triangular in
c rows and columns ILO:IHI, with any 2-by-2 diagonal blocks in
c standard form. If WANTT is .FALSE., the contents of H are
c unspecified on exit.
c
c LDH Integer. (INPUT)
c The leading dimension of the array H. LDH >= max(1,N).
c
c WR Real array, dimension (N). (OUTPUT)
c WI Real array, dimension (N). (OUTPUT)
c The real and imaginary parts, respectively, of the computed
c eigenvalues ILO to IHI are stored in the corresponding
c elements of WR and WI. If two eigenvalues are computed as a
c complex conjugate pair, they are stored in consecutive
c elements of WR and WI, say the i-th and (i+1)th, with
c WI(i) > 0 and WI(i+1) < 0. If WANTT is .TRUE., the
c eigenvalues are stored in the same order as on the diagonal
c of the Schur form returned in H, with WR(i) = H(i,i), and, if
c H(i:i+1,i:i+1) is a 2-by-2 diagonal block,
c WI(i) = sqrt(H(i+1,i)*H(i,i+1)) and WI(i+1) = -WI(i).
c
c Z Real array, dimension (N). (OUTPUT)
c On exit Z contains the last components of the Schur vectors.
c
c INFO Integer. (OUPUT)
c = 0: successful exit
c > 0: SLAQRB failed to compute all the eigenvalues ILO to IHI
c in a total of 30*(IHI-ILO+1) iterations; if INFO = i,
c elements i+1:ihi of WR and WI contain those eigenvalues
c which have been successfully computed.
c
c\Remarks
c 1. None.
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c slabad LAPACK routine that computes machine constants.
c slamch LAPACK routine that determines machine constants.
c slanhs LAPACK routine that computes various norms of a matrix.
c slanv2 LAPACK routine that computes the Schur factorization of
c 2 by 2 nonsymmetric matrix in standard form.
c slarfg LAPACK Householder reflection construction routine.
c scopy Level 1 BLAS that copies one vector to another.
c srot Level 1 BLAS that applies a rotation to a 2 by 2 matrix.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c Modified from the LAPACK routine slahqr so that only the
c last component of the Schur vectors are computed.
c
c\SCCS Information: @(#)
c FILE: laqrb.F SID: 2.2 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine slaqrb ( wantt, n, ilo, ihi, h, ldh, wr, wi,
& z, info )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
logical wantt
integer ihi, ilo, info, ldh, n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h( ldh, * ), wi( * ), wr( * ), z( * )
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, dat1, dat2
parameter (zero = 0.0E+0, one = 1.0E+0, dat1 = 7.5E-1,
& dat2 = -4.375E-1)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, i1, i2, itn, its, j, k, l, m, nh, nr
Real
& cs, h00, h10, h11, h12, h21, h22, h33, h33s,
& h43h34, h44, h44s, ovfl, s, smlnum, sn, sum,
& t1, t2, t3, tst1, ulp, unfl, v1, v2, v3
Real
& v( 3 ), work( 1 )
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch, slanhs
external slamch, slanhs
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, slabad, slanv2, slarfg, srot
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
info = 0
c
c %--------------------------%
c | Quick return if possible |
c %--------------------------%
c
if( n.eq.0 )
& return
if( ilo.eq.ihi ) then
wr( ilo ) = h( ilo, ilo )
wi( ilo ) = zero
return
end if
c
c %---------------------------------------------%
c | Initialize the vector of last components of |
c | the Schur vectors for accumulation. |
c %---------------------------------------------%
c
do 5 j = 1, n-1
z(j) = zero
5 continue
z(n) = one
c
nh = ihi - ilo + 1
c
c %-------------------------------------------------------------%
c | Set machine-dependent constants for the stopping criterion. |
c | If norm(H) <= sqrt(OVFL), overflow should not occur. |
c %-------------------------------------------------------------%
c
unfl = slamch( 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( nh / ulp )
c
c %---------------------------------------------------------------%
c | I1 and I2 are the indices of the first row and last column |
c | of H to which transformations must be applied. If eigenvalues |
c | only are computed, I1 and I2 are set inside the main loop. |
c | Zero out H(J+2,J) = ZERO for J=1:N if WANTT = .TRUE. |
c | else H(J+2,J) for J=ILO:IHI-ILO-1 if WANTT = .FALSE. |
c %---------------------------------------------------------------%
c
if( wantt ) then
i1 = 1
i2 = n
do 8 i=1,i2-2
h(i1+i+1,i) = zero
8 continue
else
do 9 i=1, ihi-ilo-1
h(ilo+i+1,ilo+i-1) = zero
9 continue
end if
c
c %---------------------------------------------------%
c | ITN is the total number of QR iterations allowed. |
c %---------------------------------------------------%
c
itn = 30*nh
c
c ------------------------------------------------------------------
c The main loop begins here. I is the loop index and decreases from
c IHI to ILO in steps of 1 or 2. Each iteration of the loop works
c with the active submatrix in rows and columns L to I.
c Eigenvalues I+1 to IHI have already converged. Either L = ILO or
c H(L,L-1) is negligible so that the matrix splits.
c ------------------------------------------------------------------
c
i = ihi
10 continue
l = ilo
if( i.lt.ilo )
& go to 150
c %--------------------------------------------------------------%
c | Perform QR iterations on rows and columns ILO to I until a |
c | submatrix of order 1 or 2 splits off at the bottom because a |
c | subdiagonal element has become negligible. |
c %--------------------------------------------------------------%
do 130 its = 0, itn
c
c %----------------------------------------------%
c | Look for a single small subdiagonal element. |
c %----------------------------------------------%
c
do 20 k = i, l + 1, -1
tst1 = abs( h( k-1, k-1 ) ) + abs( h( k, k ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', i-l+1, h( l, l ), ldh, work )
if( abs( h( k, k-1 ) ).le.max( ulp*tst1, smlnum ) )
& go to 30
20 continue
30 continue
l = k
if( l.gt.ilo ) then
c
c %------------------------%
c | H(L,L-1) is negligible |
c %------------------------%
c
h( l, l-1 ) = zero
end if
c
c %-------------------------------------------------------------%
c | Exit from loop if a submatrix of order 1 or 2 has split off |
c %-------------------------------------------------------------%
c
if( l.ge.i-1 )
& go to 140
c
c %---------------------------------------------------------%
c | Now the active submatrix is in rows and columns L to I. |
c | If eigenvalues only are being computed, only the active |
c | submatrix need be transformed. |
c %---------------------------------------------------------%
c
if( .not.wantt ) then
i1 = l
i2 = i
end if
c
if( its.eq.10 .or. its.eq.20 ) then
c
c %-------------------%
c | Exceptional shift |
c %-------------------%
c
s = abs( h( i, i-1 ) ) + abs( h( i-1, i-2 ) )
h44 = dat1*s
h33 = h44
h43h34 = dat2*s*s
c
else
c
c %-----------------------------------------%
c | Prepare to use Wilkinson's double shift |
c %-----------------------------------------%
c
h44 = h( i, i )
h33 = h( i-1, i-1 )
h43h34 = h( i, i-1 )*h( i-1, i )
end if
c
c %-----------------------------------------------------%
c | Look for two consecutive small subdiagonal elements |
c %-----------------------------------------------------%
c
do 40 m = i - 2, l, -1
c
c %---------------------------------------------------------%
c | Determine the effect of starting the double-shift QR |
c | iteration at row M, and see if this would make H(M,M-1) |
c | negligible. |
c %---------------------------------------------------------%
c
h11 = h( m, m )
h22 = h( m+1, m+1 )
h21 = h( m+1, m )
h12 = h( m, m+1 )
h44s = h44 - h11
h33s = h33 - h11
v1 = ( h33s*h44s-h43h34 ) / h21 + h12
v2 = h22 - h11 - h33s - h44s
v3 = h( m+2, m+1 )
s = abs( v1 ) + abs( v2 ) + abs( v3 )
v1 = v1 / s
v2 = v2 / s
v3 = v3 / s
v( 1 ) = v1
v( 2 ) = v2
v( 3 ) = v3
if( m.eq.l )
& go to 50
h00 = h( m-1, m-1 )
h10 = h( m, m-1 )
tst1 = abs( v1 )*( abs( h00 )+abs( h11 )+abs( h22 ) )
if( abs( h10 )*( abs( v2 )+abs( v3 ) ).le.ulp*tst1 )
& go to 50
40 continue
50 continue
c
c %----------------------%
c | Double-shift QR step |
c %----------------------%
c
do 120 k = m, i - 1
c
c ------------------------------------------------------------
c The first iteration of this loop determines a reflection G
c from the vector V and applies it from left and right to H,
c thus creating a nonzero bulge below the subdiagonal.
c
c Each subsequent iteration determines a reflection G to
c restore the Hessenberg form in the (K-1)th column, and thus
c chases the bulge one step toward the bottom of the active
c submatrix. NR is the order of G.
c ------------------------------------------------------------
c
nr = min( 3, i-k+1 )
if( k.gt.m )
& call scopy( nr, h( k, k-1 ), 1, v, 1 )
call slarfg( nr, v( 1 ), v( 2 ), 1, t1 )
if( k.gt.m ) then
h( k, k-1 ) = v( 1 )
h( k+1, k-1 ) = zero
if( k.lt.i-1 )
& h( k+2, k-1 ) = zero
else if( m.gt.l ) then
h( k, k-1 ) = -h( k, k-1 )
end if
v2 = v( 2 )
t2 = t1*v2
if( nr.eq.3 ) then
v3 = v( 3 )
t3 = t1*v3
c
c %------------------------------------------------%
c | Apply G from the left to transform the rows of |
c | the matrix in columns K to I2. |
c %------------------------------------------------%
c
do 60 j = k, i2
sum = h( k, j ) + v2*h( k+1, j ) + v3*h( k+2, j )
h( k, j ) = h( k, j ) - sum*t1
h( k+1, j ) = h( k+1, j ) - sum*t2
h( k+2, j ) = h( k+2, j ) - sum*t3
60 continue
c
c %----------------------------------------------------%
c | Apply G from the right to transform the columns of |
c | the matrix in rows I1 to min(K+3,I). |
c %----------------------------------------------------%
c
do 70 j = i1, min( k+3, i )
sum = h( j, k ) + v2*h( j, k+1 ) + v3*h( j, k+2 )
h( j, k ) = h( j, k ) - sum*t1
h( j, k+1 ) = h( j, k+1 ) - sum*t2
h( j, k+2 ) = h( j, k+2 ) - sum*t3
70 continue
c
c %----------------------------------%
c | Accumulate transformations for Z |
c %----------------------------------%
c
sum = z( k ) + v2*z( k+1 ) + v3*z( k+2 )
z( k ) = z( k ) - sum*t1
z( k+1 ) = z( k+1 ) - sum*t2
z( k+2 ) = z( k+2 ) - sum*t3
else if( nr.eq.2 ) then
c
c %------------------------------------------------%
c | Apply G from the left to transform the rows of |
c | the matrix in columns K to I2. |
c %------------------------------------------------%
c
do 90 j = k, i2
sum = h( k, j ) + v2*h( k+1, j )
h( k, j ) = h( k, j ) - sum*t1
h( k+1, j ) = h( k+1, j ) - sum*t2
90 continue
c
c %----------------------------------------------------%
c | Apply G from the right to transform the columns of |
c | the matrix in rows I1 to min(K+3,I). |
c %----------------------------------------------------%
c
do 100 j = i1, i
sum = h( j, k ) + v2*h( j, k+1 )
h( j, k ) = h( j, k ) - sum*t1
h( j, k+1 ) = h( j, k+1 ) - sum*t2
100 continue
c
c %----------------------------------%
c | Accumulate transformations for Z |
c %----------------------------------%
c
sum = z( k ) + v2*z( k+1 )
z( k ) = z( k ) - sum*t1
z( k+1 ) = z( k+1 ) - sum*t2
end if
120 continue
130 continue
c
c %-------------------------------------------------------%
c | Failure to converge in remaining number of iterations |
c %-------------------------------------------------------%
c
info = i
return
140 continue
if( l.eq.i ) then
c
c %------------------------------------------------------%
c | H(I,I-1) is negligible: one eigenvalue has converged |
c %------------------------------------------------------%
c
wr( i ) = h( i, i )
wi( i ) = zero
else if( l.eq.i-1 ) then
c
c %--------------------------------------------------------%
c | H(I-1,I-2) is negligible; |
c | a pair of eigenvalues have converged. |
c | |
c | Transform the 2-by-2 submatrix to standard Schur form, |
c | and compute and store the eigenvalues. |
c %--------------------------------------------------------%
c
call slanv2( h( i-1, i-1 ), h( i-1, i ), h( i, i-1 ),
& h( i, i ), wr( i-1 ), wi( i-1 ), wr( i ), wi( i ),
& cs, sn )
if( wantt ) then
c
c %-----------------------------------------------------%
c | Apply the transformation to the rest of H and to Z, |
c | as required. |
c %-----------------------------------------------------%
c
if( i2.gt.i )
& call srot( i2-i, h( i-1, i+1 ), ldh, h( i, i+1 ), ldh,
& cs, sn )
call srot( i-i1-1, h( i1, i-1 ), 1, h( i1, i ), 1, cs, sn )
sum = cs*z( i-1 ) + sn*z( i )
z( i ) = cs*z( i ) - sn*z( i-1 )
z( i-1 ) = sum
end if
end if
c
c %---------------------------------------------------------%
c | Decrement number of remaining iterations, and return to |
c | start of the main loop with new value of I. |
c %---------------------------------------------------------%
c
itn = itn - its
i = l - 1
go to 10
150 continue
return
c
c %---------------%
c | End of slaqrb |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dnaitr.f 0000644 0001750 0001750 00000073673 12277373057 012420 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dnaitr
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in dnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call dnaitr
c ( IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See dnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c dgetv0 ARPACK routine to generate the initial vector.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices
c dvout ARPACK utility routine that prints vectors.
c dlabad LAPACK routine that computes machine constants.
c dlamch LAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: naitr.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in dnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dnaitr
& (ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, info)
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, dgetv0, dlabad,
& dvout, dmout, ivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, dnrm2, dlanhs, dlamch
external ddot, dnrm2, dlanhs, dlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------%
c
unfl = dlamch( 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | dgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call dvout (logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call dgetv0 (ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
wnorm = ddot (n, resid, 1, workd(ipj), 1)
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = dnrm2(n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd(ipj), 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = dnrm2(n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call dvout (logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call dvout (logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workd(irj), 1)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workd(irj), 1,
& one, resid, 1)
call daxpy (j, one, workd(irj), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = dnrm2(n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call ivout (logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call dvout (logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call dmout (logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %---------------%
c | End of dnaitr |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/znaup2.f 0000644 0001750 0001750 00000071047 12277373057 012347 0000000 0000000 c\BeginDoc
c
c\Name: znaup2
c
c\Description:
c Intermediate level interface called by znaupd .
c
c\Usage:
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
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
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 (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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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
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
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
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 ivout ARPACK utility routine that prints integers.
c arscnd 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
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice Universitya
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
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 )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
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 , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex*16
& cmpnorm
Double precision
& rnorm , eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv ,
& nevbef, nev0 , np0 , eps23
c
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy , zgetv0 , znaitr , zneigh , zngets , znapps ,
& zsortc , zswap , zmout , zvout , ivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
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
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = dlamch ('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0 )
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call zgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
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,
& h, ldh, ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call ivout (logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
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
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
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,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
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)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call zngets (ishift, which, nev, np, ritz, bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
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)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call ivout (logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call zvout (logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call zvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call zvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call zvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to zneupd if needed |
c %------------------------------------------%
h(3,1) = dcmplx (rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call zsortc (wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
& dimag (ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call zsortc (wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
& dimag (ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call zsortc (which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call zvout (logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call zvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call zngets (ishift, which, nev, np, ritz, bounds)
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call zvout (logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call zvout (logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
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,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call zvout (logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
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,
& 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 %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
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)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call dvout (logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call zmout (logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %---------------%
c | End of znaup2 |
c %---------------%
c
return
end
arpack-ng-3.1.5/SRC/dnaupd.f 0000644 0001750 0001750 00000072026 12277373057 012401 0000000 0000000 c\BeginDoc
c
c\Name: dnaupd
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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 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.
c
c dnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call dnaupd
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 dnaupd . 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 dnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
c TOL Double precision scalar. (INPUT/OUTPUT)
c Stopping criterion: 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 auxiliary subroutine DLAMCH ).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Double precision array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 dnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), dnaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by dneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 -------------------------------------------------------------
c
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 an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine dneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine dneupd .
c
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 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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c dnaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dlamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Revision history:
c 12/16/93: Version '1.1'
c
c\SCCS Information: @(#)
c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dnaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0 , zero = 0.0D+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dnaup2 , dvout , ivout, arscnd, dstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch
external dlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = dlamch ('EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine dneigh called |
c | by dnaup2 . Subroutine dneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call dnaup2
& ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within dnaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call dvout (logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call dvout (logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call dvout (logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.4' , 21x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of dnaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/snconv.f 0000644 0001750 0001750 00000007641 12277373057 012435 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: snconv
c
c\Description:
c Convergence testing for the nonsymmetric Arnoldi eigenvalue routine.
c
c\Usage:
c call snconv
c ( N, RITZR, RITZI, BOUNDS, TOL, NCONV )
c
c\Arguments
c N Integer. (INPUT)
c Number of Ritz values to check for convergence.
c
c RITZR, Real arrays of length N. (INPUT)
c RITZI Real and imaginary parts of the Ritz values to be checked
c for convergence.
c BOUNDS Real array of length N. (INPUT)
c Ritz estimates for the Ritz values in RITZR and RITZI.
c
c TOL Real scalar. (INPUT)
c Desired backward error for a Ritz value to be considered
c "converged".
c
c NCONV Integer scalar. (OUTPUT)
c Number of "converged" Ritz values.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: nconv.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine snconv (n, ritzr, ritzi, bounds, tol, nconv)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, nconv
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
Real
& ritzr(n), ritzi(n), bounds(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i
Real
& temp, eps23
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, slamch
external slapy2, slamch
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------------------%
c | Convergence test: unlike in the symmetric code, I am not |
c | using things like refined error bounds and gap condition |
c | because I don't know the exact equivalent concept. |
c | |
c | Instead the i-th Ritz value is considered "converged" when: |
c | |
c | bounds(i) .le. ( TOL * | ritz | ) |
c | |
c | for some appropriate choice of norm. |
c %-------------------------------------------------------------%
c
call arscnd (t0)
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0)
c
nconv = 0
do 20 i = 1, n
temp = max( eps23, slapy2( ritzr(i), ritzi(i) ) )
if (bounds(i) .le. tol*temp) nconv = nconv + 1
20 continue
c
call arscnd (t1)
tnconv = tnconv + (t1 - t0)
c
return
c
c %---------------%
c | End of snconv |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cnaup2.f 0000644 0001750 0001750 00000071035 12277373057 012315 0000000 0000000 c\BeginDoc
c
c\Name: cnaup2
c
c\Description:
c Intermediate level interface called by cnaupd.
c
c\Usage:
c call cnaup2
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 cnaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in cnaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
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 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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 Private (replicated) array on each PE or array allocated on
c the front end.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c cgetv0 ARPACK initial vector generation routine.
c cnaitr ARPACK Arnoldi factorization routine.
c cnapps ARPACK application of implicit shifts routine.
c cneigh ARPACK compute Ritz values and error bounds routine.
c cngets ARPACK reorder Ritz values and error bounds routine.
c csortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd 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 slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c cswap Level 1 BLAS that swaps two vectors.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice Universitya
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: naup2.F SID: 2.6 DATE OF SID: 06/01/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cnaup2
& ( 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 )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
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 , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex
& cmpnorm
Real
& rnorm , eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv ,
& nevbef, nev0 , np0 , eps23
c
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, cgetv0, cnaitr, cneigh, cngets, cnapps,
& csortc, cswap, cmout, cvout, ivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
Complex
& cdotc
Real
& scnrm2, slamch, slapy2
external cdotc, scnrm2, slamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real , min, max
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call cgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call cnaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 cnapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call ivout (logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
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
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call svout (logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call cneigh (rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
c | Ritz estimates obtained from cneigh. |
c %--------------------------------------------------%
c
call ccopy(kplusp,ritz,1,workl(kplusp**2+1),1)
call ccopy(kplusp,bounds,1,workl(kplusp**2+kplusp+1),1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call cngets (ishift, which, nev, np, ritz, bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
c
nconv = 0
c
do 25 i = 1, nev
rtemp = max( eps23, slapy2( real (ritz(np+i)),
& aimag(ritz(np+i)) ) )
if ( slapy2(real (bounds(np+i)),aimag(bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call ivout (logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call cvout (logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call cvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call cvout(logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call cvout(logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to cneupd if needed |
c %------------------------------------------%
h(3,1) = cmplx(rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call csortc(wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, slapy2( real (ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call csortc(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, slapy2( real (ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call csortc(which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call cvout (logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call cvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call cngets (ishift, which, nev, np, ritz, bounds)
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call cvout (logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call cvout (logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call ccopy (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 cvout (logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call cvout (logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call cnapps (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 cnaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cmpnorm = cdotc (n, resid, 1, workd, 1)
rnorm = sqrt(slapy2(real (cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call svout (logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call cmout (logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %---------------%
c | End of cnaup2 |
c %---------------%
c
return
end
arpack-ng-3.1.5/SRC/sstatn.f 0000644 0001750 0001750 00000002710 12277373057 012433 0000000 0000000 c
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for nonsymmetric Arnoldi code. |
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: statn.F SID: 2.4 DATE OF SID: 4/20/96 RELEASE: 2
c
subroutine sstatn
c
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
include 'stat.h'
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
c
tnaupd = 0.0E+0
tnaup2 = 0.0E+0
tnaitr = 0.0E+0
tneigh = 0.0E+0
tngets = 0.0E+0
tnapps = 0.0E+0
tnconv = 0.0E+0
titref = 0.0E+0
tgetv0 = 0.0E+0
trvec = 0.0E+0
c
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
c
tmvopx = 0.0E+0
tmvbx = 0.0E+0
c
return
c
c
c %---------------%
c | End of sstatn |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/cgetv0.f 0000644 0001750 0001750 00000031150 12277373057 012307 0000000 0000000 c\BeginDoc
c
c\Name: cgetv0
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call cgetv0
c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, IERR )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to cgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that cgetv0 is called.
c It should be set to 1 on the initial call to cgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c cvout ARPACK utility routine that prints vectors.
c clarnv LAPACK routine for generating a random vector.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c ccopy Level 1 BLAS that copies one vector to another.
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
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: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cgetv0
& ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, 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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& resid(n), v(ldv,j), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0),
& rzero = 0.0E+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Real
& rnorm0
Complex
& cnorm
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, cgemv, clarnv, cvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2, slapy2
Complex
& cdotc
external cdotc, scnrm2, slapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call clarnv (idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call ccopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
rnorm0 = sqrt(slapy2(real(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = scnrm2(n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call cgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workd(n+1), 1)
call cgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
rnorm = sqrt(slapy2(real(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call svout (logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call svout (logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call svout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call cvout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of cgetv0 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dseupd.f 0000644 0001750 0001750 00000104050 12277373057 012403 0000000 0000000 c\BeginDoc
c
c\Name: dseupd
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 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 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
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 ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as a workspace for
c reordering the Ritz values.
c
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 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 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
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 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 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
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(1:4*ncv) contains information obtained in
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 -------------------------------------------------------------
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 -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 = -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 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 corresponding permutation to a matrix A.
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 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 factored form.
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\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Revision history:
c 12/15/93: Version ' 2.1'
c
c\SCCS Information: @(#)
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 )
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Double precision
& 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
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dnrm2 , dlamch
external dnrm2 , dlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev .or. ncv .gt. n) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | 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 %-------------------------------------------------------%
c
c %-------------------------------------------------------%
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | 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 | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
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 | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
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
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 | 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, 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. nconv) 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, 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 dcopy (ncv-1, workl(ih+1), 1, workl(ihb), 1)
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
call dvout (logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
call dvout (logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if ( .not. select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
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,
& workl(iw), 1)
call dcopy (ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call dcopy (ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
end if
c
30 if (msglvl .gt. 2) then
call dvout (logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call dcopy (nconv, workl(ihd), 1, d, 1)
c
else
c
c %-----------------------------------------------------%
c | Ritz vectors not required. Load Ritz values into D. |
c %-----------------------------------------------------%
c
call dcopy (nconv, workl(ritz), 1, d, 1)
call dcopy (ncv, workl(ritz), 1, workl(ihd), 1)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
c | bounds. Not necessary if only Ritz values are desired. |
c %---------------------------------------------------------%
c
if (rvec) then
call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy (ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 | 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)
if (type .eq. 'SHIFTI') then
do 40 k=1, ncv
workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
call dcopy (nconv, workl(ihd), 1, d, 1)
call dsortr ('LA', .true., nconv, workl(ihd), workl(iw))
if (rvec) then
call dsesrt ('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy (ncv, workl(bounds), 1, workl(ihb), 1)
call dscal (ncv, bnorm2/rnorm, workl(ihb), 1)
call dsortr ('LA', .true., nconv, d, workl(ihb))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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 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 %-----------------------------------------------------%
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)
c
c %-----------------------------------------------------%
c | Make a copy of the last row into |
c | workl(iw+ncv:iw+2*ncv), as it is needed again in |
c | the Ritz vector purification step below |
c %-----------------------------------------------------%
c
do 67 j = 1, nconv
workl(iw+ncv+j-1) = workl(ihb+j-1)
67 continue
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call dvout (logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
call dvout (logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
call dvout (logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
call dvout (logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
c
if (rvec .and. (type .eq. 'SHIFTI' .or. type .eq. 'CAYLEY')) then
c
do 110 k=0, nconv-1
workl(iw+k) = workl(iw+ncv+k)
& / 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(iw+ncv+k)
& / (workl(iw+k)-one)
120 continue
c
end if
c
if (rvec .and. type .ne. 'REGULR')
& call dger (n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %---------------%
c | End of dseupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsesrt.f 0000644 0001750 0001750 00000012370 12277373057 012426 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsesrt
c
c\Description:
c Sort the array X in the order specified by WHICH and optionally
c apply the permutation to the columns of the matrix A.
c
c\Usage:
c call dsesrt
c ( WHICH, APPLY, N, X, NA, A, LDA)
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> X is sorted into increasing order of magnitude.
c 'SM' -> X is sorted into decreasing order of magnitude.
c 'LA' -> X is sorted into increasing order of algebraic.
c 'SA' -> X is sorted into decreasing order of algebraic.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to A.
c APPLY = .FALSE. -> do not apply the sorted order to A.
c
c N Integer. (INPUT)
c Dimension of the array X.
c
c X Double precision array of length N. (INPUT/OUTPUT)
c The array to be sorted.
c
c NA Integer. (INPUT)
c Number of rows of the matrix A.
c
c A Double precision array of length NA by N. (INPUT/OUTPUT)
c
c LDA Integer. (INPUT)
c Leading dimension of A.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines
c dswap Level 1 BLAS that swaps the contents of two vectors.
c
c\Authors
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\Revision history:
c 12/15/93: Version ' 2.1'.
c Adapted from the sort routine in LANSO and
c the ARPACK code dsortr
c
c\SCCS Information: @(#)
c FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsesrt (which, apply, n, x, na, a, lda)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer lda, n, na
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& x(0:n-1), a(lda, 0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Double precision
& temp
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dswap
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'SA') then
c
c X is sorted into decreasing order of algebraic.
c
10 continue
if (igap .eq. 0) go to 9000
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
if (x(j).lt.x(j+igap)) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 30
endif
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c X is sorted into decreasing order of magnitude.
c
40 continue
if (igap .eq. 0) go to 9000
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j.lt.0) go to 60
c
if (abs(x(j)).lt.abs(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LA') then
c
c X is sorted into increasing order of algebraic.
c
70 continue
if (igap .eq. 0) go to 9000
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (x(j).gt.x(j+igap)) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'LM') then
c
c X is sorted into increasing order of magnitude.
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (abs(x(j)).gt.abs(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
if (apply) call dswap( na, a(1, j), 1, a(1,j+igap), 1)
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
end if
c
9000 continue
return
c
c %---------------%
c | End of dsesrt |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sneigh.f 0000644 0001750 0001750 00000024035 12277373057 012400 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: sneigh
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 sneigh
c ( RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, 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 Real 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 RITZR, Real arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Real 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 Real 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 IERR Integer. (OUTPUT)
c Error exit flag from slaqrb or strevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c slaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c slacpy LAPACK matrix copy routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another .
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales 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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: neigh.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine sneigh (rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, 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
Real
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Real
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, slacpy, slaqrb, strevc, svout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call smout (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 | slaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call slacpy ('All', n, n, h, ldh, workl, n)
call slaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call svout (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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call strevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | strevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = snrm2( n, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = slapy2( snrm2( n, q(1,i), 1 ),
& snrm2( n, q(1,i+1), 1 ) )
call sscal ( n, one / temp, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call sgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call svout (logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * slapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call svout (logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call svout (logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call svout (logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of sneigh |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/sstats.f 0000644 0001750 0001750 00000002216 12277373057 012441 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: stats.F SID: 2.1 DATE OF SID: 4/19/96 RELEASE: 2
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for symmetric Arnoldi code. |
c %---------------------------------------------%
subroutine sstats
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
include 'stat.h'
c %-----------------------%
c | Executable Statements |
c %-----------------------%
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
tsaupd = 0.0E+0
tsaup2 = 0.0E+0
tsaitr = 0.0E+0
tseigt = 0.0E+0
tsgets = 0.0E+0
tsapps = 0.0E+0
tsconv = 0.0E+0
titref = 0.0E+0
tgetv0 = 0.0E+0
trvec = 0.0E+0
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
tmvopx = 0.0E+0
tmvbx = 0.0E+0
return
c
c End of sstats
c
end
arpack-ng-3.1.5/SRC/sngets.f 0000644 0001750 0001750 00000017454 12277373057 012435 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: sngets
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call sngets
c ( ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Real array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortc ARPACK sorting routine.
c scopy Level 1 BLAS that copies one vector to another .
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\Revision history:
c xx/xx/92: Version ' 2.1'
c
c\SCCS Information: @(#)
c FILE: ngets.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine sngets ( ishift, which, kev, np, ritzr, ritzi, bounds,
& shiftr, shifti )
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, ssortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call ssortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call ssortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call ssortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine snapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call ssortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, kev, ndigit, '_ngets: KEV is')
call ivout (logfil, 1, np, ndigit, '_ngets: NP is')
call svout (logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call svout (logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call svout (logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %---------------%
c | End of sngets |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dsconv.f 0000644 0001750 0001750 00000006602 12277373057 012417 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dsconv
c
c\Description:
c Convergence testing for the symmetric Arnoldi eigenvalue routine.
c
c\Usage:
c call dsconv
c ( N, RITZ, BOUNDS, TOL, NCONV )
c
c\Arguments
c N Integer. (INPUT)
c Number of Ritz values to check for convergence.
c
c RITZ Double precision array of length N. (INPUT)
c The Ritz values to be checked for convergence.
c
c BOUNDS Double precision array of length N. (INPUT)
c Ritz estimates associated with the Ritz values in RITZ.
c
c TOL Double precision scalar. (INPUT)
c Desired relative accuracy for a Ritz value to be considered
c "converged".
c
c NCONV Integer scalar. (OUTPUT)
c Number of "converged" Ritz values.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c dlamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sconv.F SID: 2.4 DATE OF SID: 4/19/96 RELEASE: 2
c
c\Remarks
c 1. Starting with version 2.4, this routine no longer uses the
c Parlett strategy using the gap conditions.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dsconv (n, ritz, bounds, tol, nconv)
c
c %----------------------------------------------------%
c | Include files for debugging and timing information |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, nconv
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& ritz(n), bounds(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i
Double precision
& temp, eps23
c
c %-------------------%
c | External routines |
c %-------------------%
c
Double precision
& dlamch
external dlamch
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call arscnd (t0)
c
eps23 = dlamch('Epsilon-Machine')
eps23 = eps23**(2.0D+0 / 3.0D+0)
c
nconv = 0
do 10 i = 1, n
c
c %-----------------------------------------------------%
c | The i-th Ritz value is considered "converged" |
c | when: bounds(i) .le. TOL*max(eps23, abs(ritz(i))) |
c %-----------------------------------------------------%
c
temp = max( eps23, abs(ritz(i)) )
if ( bounds(i) .le. tol*temp ) then
nconv = nconv + 1
end if
c
10 continue
c
call arscnd (t1)
tsconv = tsconv + (t1 - t0)
c
return
c
c %---------------%
c | End of dsconv |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/snaupd.f 0000644 0001750 0001750 00000071776 12277373057 012433 0000000 0000000 c\BeginDoc
c
c\Name: snaupd
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c snaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call snaupd
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 snaupd. 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 snaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Real array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 snaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), snaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by sneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 sneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
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
c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine sneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine sneupd.
c
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 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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Real resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Real resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c snaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Revision history:
c 12/16/93: Version '1.1'
c
c\SCCS Information: @(#)
c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine snaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external snaup2, svout, ivout, arscnd, sstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch
external slamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = slamch('EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine sneigh called |
c | by snaup2. Subroutine sneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call snaup2
& ( ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within snaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call svout (logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call svout (logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call svout (logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.4' , 21x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of snaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/zstatn.f 0000644 0001750 0001750 00000002305 12277373057 012442 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: statn.F SID: 2.2 DATE OF SID: 4/20/96 RELEASE: 2
c
c %---------------------------------------------%
c | Initialize statistic and timing information |
c | for complex nonsymmetric Arnoldi code. |
c %---------------------------------------------%
subroutine zstatn
c
c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
include 'stat.h'
c %-----------------------%
c | Executable Statements |
c %-----------------------%
nopx = 0
nbx = 0
nrorth = 0
nitref = 0
nrstrt = 0
tcaupd = 0.0D+0
tcaup2 = 0.0D+0
tcaitr = 0.0D+0
tceigh = 0.0D+0
tcgets = 0.0D+0
tcapps = 0.0D+0
tcconv = 0.0D+0
titref = 0.0D+0
tgetv0 = 0.0D+0
trvec = 0.0D+0
c %----------------------------------------------------%
c | User time including reverse communication overhead |
c %----------------------------------------------------%
tmvopx = 0.0D+0
tmvbx = 0.0D+0
return
c
c %---------------%
c | End of zstatn |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssapps.f 0000644 0001750 0001750 00000043732 12277373057 012441 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call ssapps
c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Real array of length NP. (INPUT)
c The shifts to be applied.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c slartg LAPACK Givens rotation construction routine.
c slacpy LAPACK matrix copy routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector.
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\Revision history:
c 12/16/93: Version ' 2.4'
c
c\SCCS Information: @(#)
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
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssapps
& ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Real
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slartg, slaset, svout,
& ivout, arscnd, sgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slamch
external slamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = slamch('Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call svout (logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call sscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call svout (logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call sgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call saxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call svout (logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call svout (logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call svout (logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call svout (logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of ssapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/znaupd.f 0000644 0001750 0001750 00000066172 12277373057 012434 0000000 0000000 c\BeginDoc
c
c\Name: znaupd
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then dsaupd or dnaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c znaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x.
c ===> OP = A and B = I.
c
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 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call znaupd
c ( IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to znaupd . 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 znaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 auxiliary subroutine dlamch ).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below.)
c
c V Complex*16 array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of znaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by zneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 zneupd if RVEC = .TRUE. See Remark 2 below.
c
c -------------------------------------------------------------
c
c WORKD Complex*16 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex*16 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Double precision work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine zneupd .
c
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 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 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
c 4. At present there is no a-priori analysis to guide the selection
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex*16 resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex*16 resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c znaup2 ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c zstatn ARPACK routine that initializes the timing variables.
c ivout ARPACK utility routine that prints integers.
c zvout ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c dlamch LAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: naupd.F SID: 2.8 DATE OF SID: 04/10/01 RELEASE: 2
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine znaupd
& ( ido, 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 |
c %----------------------------------------------------%
c
include 'debug.h'
include 'stat.h'
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex*16
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Double precision
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0D+0, 0.0D+0) , zero = (0.0D+0, 0.0D+0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external znaup2 , zvout , ivout, arscnd, zstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlamch
external dlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call zstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0D+0 ) tol = dlamch ('EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine zneigh called |
c | by znaup2 . Subroutine zneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call znaup2
& ( 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within znaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call ivout (logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call zvout (logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call zvout (logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.3' , 21x, ' =',/
& 5x, '= Version Date: ', ' 07/31/96' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
c
9000 continue
c
return
c
c %---------------%
c | End of znaupd |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/snaup2.f 0000644 0001750 0001750 00000075656 12277373057 012352 0000000 0000000 c\BeginDoc
c
c\Name: snaup2
c
c\Description:
c Intermediate level interface called by snaupd.
c
c\Usage:
c call snaup2
c ( IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in snaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in snaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (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 RITZR, Real arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from sneigh.
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Real 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c sgetv0 ARPACK initial vector generation routine.
c snaitr ARPACK Arnoldi factorization routine.
c snapps ARPACK application of implicit shifts routine.
c snconv ARPACK convergence of Ritz values routine.
c sneigh ARPACK compute Ritz values and error bounds routine.
c sngets ARPACK reorder Ritz values and error bounds routine.
c ssortc ARPACK sorting routine.
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c slamch LAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sswap Level 1 BLAS that swaps two vectors.
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: naup2.F SID: 2.8 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine snaup2
& ( ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Real
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0 , zero = 0.0E+0 )
c
c %---------------%
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
Real
& 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)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy , sgetv0, snaitr, snconv, sneigh,
& sngets, snapps, svout , ivout , arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, snrm2, slapy2, slamch
external sdot, snrm2, slapy2, slamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = slamch('Epsilon-Machine')
eps23 = eps23**(2.0E+0 / 3.0E+0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call sgetv0 (ido, bmat, 1, initv, n, 1, v, ldv, resid, rnorm,
& ipntr, workd, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call snaitr (ido, bmat, n, 0, nev, mode, resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 snapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call ivout (logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call ivout (logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
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 |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call svout (logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call sneigh (rnorm, kplusp, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from sneigh. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call scopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of sngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call sngets (ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call snconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call ivout (logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call svout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call svout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call svout (logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call svout(logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with sngets, we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in sngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call ssortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call ssortc(wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call ssortc(which, .true., nconv, ritzr, ritzi, bounds)
c
if (msglvl .gt. 1) then
call svout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call svout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call svout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
c %---- Scipy fix ------------------------------------------------
c | We must keep nev below this value, as otherwise we can get
c | np == 0 (note that sngets below can bump nev by 1). If np == 0,
c | the next call to `snaitr` will write out-of-bounds.
c |
if (nev .gt. kplusp - 2) then
nev = kplusp - 2
end if
c |
c %---- Scipy fix end --------------------------------------------
c
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call sngets (ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call ivout (logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call ivout (logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call svout (logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call svout (logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call svout (logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call scopy (np, workl, 1, ritzr, 1)
call scopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call svout (logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call svout (logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call svout (logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call snapps (n, nev, np, ritzr, ritzi, 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 snaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = snrm2(n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call svout (logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call smout (logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %---------------%
c | End of snaup2 |
c %---------------%
c
return
end
arpack-ng-3.1.5/SRC/zgetv0.f 0000644 0001750 0001750 00000031274 12277373057 012345 0000000 0000000 c\BeginDoc
c
c\Name: zgetv0
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call zgetv0
c ( IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, IERR )
c
c\Arguments
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to zgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that zgetv0 is called.
c It should be set to 1 on the initial call to zgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex*16 N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex*16 work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c zvout ARPACK utility routine that prints vectors.
c zlarnv LAPACK routine for generating a random vector.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
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 dznrm2 Level 1 BLAS that computes the norm of a vector.
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: getv0.F SID: 2.3 DATE OF SID: 08/27/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine zgetv0
& ( ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, 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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& resid(n), v(ldv,j), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
& rzero = 0.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Double precision
& rnorm0
Complex*16
& cnorm
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy, zgemv, zlarnv, zvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2, dlapy2
Complex*16
& zdotc
external zdotc, dznrm2, dlapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call zlarnv (idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call zcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
rnorm0 = sqrt(dlapy2(dble(cnorm),dimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = dznrm2(n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call zgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workd(n+1), 1)
call zgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
rnorm = sqrt(dlapy2(dble(cnorm),dimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call dvout (logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call dvout (logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call dvout (logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call zvout (logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of zgetv0 |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/znapps.f 0000644 0001750 0001750 00000042331 12277373057 012435 0000000 0000000 c\BeginDoc
c
c\Name: znapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call znapps
c ( N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex*16 array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex*16 N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex*16 KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex*16 work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c ivout ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c zmout ARPACK utility routine that prints matrices
c zvout ARPACK utility routine that prints vectors.
c zlacpy LAPACK matrix copy routine.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlartg LAPACK Givens rotation construction routine.
c zlaset LAPACK matrix initialization routine.
c dlabad LAPACK routine for defining the underflow and overflow
c limits.
c dlamch LAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
c zcopy Level 1 BLAS that copies one vector to another.
c zscal Level 1 BLAS that scales a vector.
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: 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
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine zlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine znapps
& ( n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0D+0, 0.0D+0), zero = (0.0D+0, 0.0D+0),
& rzero = 0.0D+0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex*16
& cdum, f, g, h11, h21, r, s, sigma, t
Double precision
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zgemv, zscal, zlacpy, zlartg,
& zvout, zlaset, dlabad, zmout, arscnd, ivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& zlanhs, dlamch, dlapy2
external zlanhs, dlamch, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, dimag, conjg, dcmplx, max, min, dble
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Double precision
& zabs1
zabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------------%
c
unfl = dlamch( 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call zlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call ivout (logfil, 1, jj, ndigit,
& '_napps: shift number.')
call zvout (logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %----------------------------------------%
c
tst1 = zabs1( h( i, i ) ) + zabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = zlanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(dble(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call ivout (logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call ivout (logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call zvout (logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call ivout (logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call ivout (logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call zlartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( dble( h(j+1,j) ) .lt. rzero .or.
& dimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / dlapy2(dble(h(j+1,j)),dimag(h(j+1,j)))
call zscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call zscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call zscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = dcmplx( dble( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = zabs1( h( i, i ) ) + zabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = zlanhs( '1', kev, h, ldh, workl )
if( dble( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call zgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call zcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call zlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call zscal (n, q(kplusp,kev), resid, 1)
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zaxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call zvout (logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call zvout (logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call ivout (logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call zmout (logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %---------------%
c | End of znapps |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/ssortc.f 0000644 0001750 0001750 00000021752 12277373057 012443 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: ssortc
c
c\Description:
c Sorts the complex array in XREAL and XIMAG into the order
c specified by WHICH and optionally applies the permutation to the
c real array Y. It is assumed that if an element of XIMAG is
c nonzero, then its negative is also an element. In other words,
c both members of a complex conjugate pair are to be sorted and the
c pairs are kept adjacent to each other.
c
c\Usage:
c call ssortc
c ( WHICH, APPLY, N, XREAL, XIMAG, Y )
c
c\Arguments
c WHICH Character*2. (Input)
c 'LM' -> sort XREAL,XIMAG into increasing order of magnitude.
c 'SM' -> sort XREAL,XIMAG into decreasing order of magnitude.
c 'LR' -> sort XREAL into increasing order of algebraic.
c 'SR' -> sort XREAL into decreasing order of algebraic.
c 'LI' -> sort XIMAG into increasing order of magnitude.
c 'SI' -> sort XIMAG into decreasing order of magnitude.
c NOTE: If an element of XIMAG is non-zero, then its negative
c is also an element.
c
c APPLY Logical. (Input)
c APPLY = .TRUE. -> apply the sorted order to array Y.
c APPLY = .FALSE. -> do not apply the sorted order to array Y.
c
c N Integer. (INPUT)
c Size of the arrays.
c
c XREAL, Real array of length N. (INPUT/OUTPUT)
c XIMAG Real and imaginary part of the array to be sorted.
c
c Y Real array of length N. (INPUT/OUTPUT)
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
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\Revision history:
c xx/xx/92: Version ' 2.1'
c Adapted from the sort routine in LANSO.
c
c\SCCS Information: @(#)
c FILE: sortc.F SID: 2.3 DATE OF SID: 4/20/96 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine ssortc (which, apply, n, xreal, ximag, y)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character*2 which
logical apply
integer n
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& xreal(0:n-1), ximag(0:n-1), y(0:n-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, igap, j
Real
& temp, temp1, temp2
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2
external slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
igap = n / 2
c
if (which .eq. 'LM') then
c
c %------------------------------------------------------%
c | Sort XREAL,XIMAG into increasing order of magnitude. |
c %------------------------------------------------------%
c
10 continue
if (igap .eq. 0) go to 9000
c
do 30 i = igap, n-1
j = i-igap
20 continue
c
if (j.lt.0) go to 30
c
temp1 = slapy2(xreal(j),ximag(j))
temp2 = slapy2(xreal(j+igap),ximag(j+igap))
c
if (temp1.gt.temp2) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 30
end if
j = j-igap
go to 20
30 continue
igap = igap / 2
go to 10
c
else if (which .eq. 'SM') then
c
c %------------------------------------------------------%
c | Sort XREAL,XIMAG into decreasing order of magnitude. |
c %------------------------------------------------------%
c
40 continue
if (igap .eq. 0) go to 9000
c
do 60 i = igap, n-1
j = i-igap
50 continue
c
if (j .lt. 0) go to 60
c
temp1 = slapy2(xreal(j),ximag(j))
temp2 = slapy2(xreal(j+igap),ximag(j+igap))
c
if (temp1.lt.temp2) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 60
endif
j = j-igap
go to 50
60 continue
igap = igap / 2
go to 40
c
else if (which .eq. 'LR') then
c
c %------------------------------------------------%
c | Sort XREAL into increasing order of algebraic. |
c %------------------------------------------------%
c
70 continue
if (igap .eq. 0) go to 9000
c
do 90 i = igap, n-1
j = i-igap
80 continue
c
if (j.lt.0) go to 90
c
if (xreal(j).gt.xreal(j+igap)) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 90
endif
j = j-igap
go to 80
90 continue
igap = igap / 2
go to 70
c
else if (which .eq. 'SR') then
c
c %------------------------------------------------%
c | Sort XREAL into decreasing order of algebraic. |
c %------------------------------------------------%
c
100 continue
if (igap .eq. 0) go to 9000
do 120 i = igap, n-1
j = i-igap
110 continue
c
if (j.lt.0) go to 120
c
if (xreal(j).lt.xreal(j+igap)) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 120
endif
j = j-igap
go to 110
120 continue
igap = igap / 2
go to 100
c
else if (which .eq. 'LI') then
c
c %------------------------------------------------%
c | Sort XIMAG into increasing order of magnitude. |
c %------------------------------------------------%
c
130 continue
if (igap .eq. 0) go to 9000
do 150 i = igap, n-1
j = i-igap
140 continue
c
if (j.lt.0) go to 150
c
if (abs(ximag(j)).gt.abs(ximag(j+igap))) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 150
endif
j = j-igap
go to 140
150 continue
igap = igap / 2
go to 130
c
else if (which .eq. 'SI') then
c
c %------------------------------------------------%
c | Sort XIMAG into decreasing order of magnitude. |
c %------------------------------------------------%
c
160 continue
if (igap .eq. 0) go to 9000
do 180 i = igap, n-1
j = i-igap
170 continue
c
if (j.lt.0) go to 180
c
if (abs(ximag(j)).lt.abs(ximag(j+igap))) then
temp = xreal(j)
xreal(j) = xreal(j+igap)
xreal(j+igap) = temp
c
temp = ximag(j)
ximag(j) = ximag(j+igap)
ximag(j+igap) = temp
c
if (apply) then
temp = y(j)
y(j) = y(j+igap)
y(j+igap) = temp
end if
else
go to 180
endif
j = j-igap
go to 170
180 continue
igap = igap / 2
go to 160
end if
c
9000 continue
return
c
c %---------------%
c | End of ssortc |
c %---------------%
c
end
arpack-ng-3.1.5/SRC/dseigt.f 0000644 0001750 0001750 00000012115 12277373057 012376 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: dseigt
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call dseigt
c ( RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c RNORM Double precision scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Double precision N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Double precision array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Double precision work array of length 3*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 dstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c dvout ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
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\Revision history:
c xx/xx/92: Version ' 2.4'
c
c\SCCS Information: @(#)
c FILE: seigt.F SID: 2.4 DATE OF SID: 8/27/96 RELEASE: 2
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine dseigt
& ( rnorm, n, h, ldh, eig, bounds, workl, 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, ldh, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dstqrb, dvout, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call dvout (logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call dvout (logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
call dcopy (n, h(1,2), 1, eig, 1)
call dcopy (n-1, h(2,1), 1, workl, 1)
call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
if (msglvl .gt. 1) then
call dvout (logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %---------------%
c | End of dseigt |
c %---------------%
c
end
arpack-ng-3.1.5/config.guess 0000755 0001750 0001750 00000130361 12277373057 012645 0000000 0000000 #! /bin/sh
# Attempt to guess a canonical system name.
# Copyright 1992-2013 Free Software Foundation, Inc.
timestamp='2013-06-10'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see .
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that
# program. This Exception is an additional permission under section 7
# of the GNU General Public License, version 3 ("GPLv3").
#
# Originally written by Per Bothner.
#
# You can get the latest version of this script from:
# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
#
# Please send patches with a ChangeLog entry to config-patches@gnu.org.
me=`echo "$0" | sed -e 's,.*/,,'`
usage="\
Usage: $0 [OPTION]
Output the configuration name of the system \`$me' is run on.
Operation modes:
-h, --help print this help, then exit
-t, --time-stamp print date of last modification, then exit
-v, --version print version number, then exit
Report bugs and patches to ."
version="\
GNU config.guess ($timestamp)
Originally written by Per Bothner.
Copyright 1992-2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
Try \`$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
case $1 in
--time-stamp | --time* | -t )
echo "$timestamp" ; exit ;;
--version | -v )
echo "$version" ; exit ;;
--help | --h* | -h )
echo "$usage"; exit ;;
-- ) # Stop option processing
shift; break ;;
- ) # Use stdin as input.
break ;;
-* )
echo "$me: invalid option $1$help" >&2
exit 1 ;;
* )
break ;;
esac
done
if test $# != 0; then
echo "$me: too many arguments$help" >&2
exit 1
fi
trap 'exit 1' 1 2 15
# CC_FOR_BUILD -- compiler used by this script. Note that the use of a
# compiler to aid in system detection is discouraged as it requires
# temporary files to be created and, as you can see below, it is a
# headache to deal with in a portable fashion.
# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still
# use `HOST_CC' if defined, but it is deprecated.
# Portable tmp directory creation inspired by the Autoconf team.
set_cc_for_build='
trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ;
trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ;
: ${TMPDIR=/tmp} ;
{ tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } ||
{ test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } ||
{ tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } ||
{ echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ;
dummy=$tmp/dummy ;
tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ;
case $CC_FOR_BUILD,$HOST_CC,$CC in
,,) echo "int x;" > $dummy.c ;
for c in cc gcc c89 c99 ; do
if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then
CC_FOR_BUILD="$c"; break ;
fi ;
done ;
if test x"$CC_FOR_BUILD" = x ; then
CC_FOR_BUILD=no_compiler_found ;
fi
;;
,,*) CC_FOR_BUILD=$CC ;;
,*,*) CC_FOR_BUILD=$HOST_CC ;;
esac ; set_cc_for_build= ;'
# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
# (ghazi@noc.rutgers.edu 1994-08-24)
if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
PATH=$PATH:/.attbin ; export PATH
fi
UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
case "${UNAME_SYSTEM}" in
Linux|GNU|GNU/*)
# If the system lacks a compiler, then just pick glibc.
# We could probably try harder.
LIBC=gnu
eval $set_cc_for_build
cat <<-EOF > $dummy.c
#include
#if defined(__UCLIBC__)
LIBC=uclibc
#elif defined(__dietlibc__)
LIBC=dietlibc
#else
LIBC=gnu
#endif
EOF
eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
;;
esac
# Note: order is significant - the case branches are not exclusive.
case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
*:NetBSD:*:*)
# NetBSD (nbsd) targets should (where applicable) match one or
# more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*,
# *-*-netbsdecoff* and *-*-netbsd*. For targets that recently
# switched to ELF, *-*-netbsd* would select the old
# object file format. This provides both forward
# compatibility and a consistent mechanism for selecting the
# object file format.
#
# Note: NetBSD doesn't particularly care about the vendor
# portion of the name. We always set it to "unknown".
sysctl="sysctl -n hw.machine_arch"
UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \
/usr/sbin/$sysctl 2>/dev/null || echo unknown)`
case "${UNAME_MACHINE_ARCH}" in
armeb) machine=armeb-unknown ;;
arm*) machine=arm-unknown ;;
sh3el) machine=shl-unknown ;;
sh3eb) machine=sh-unknown ;;
sh5el) machine=sh5le-unknown ;;
*) machine=${UNAME_MACHINE_ARCH}-unknown ;;
esac
# The Operating System including object format, if it has switched
# to ELF recently, or will in the future.
case "${UNAME_MACHINE_ARCH}" in
arm*|i386|m68k|ns32k|sh3*|sparc|vax)
eval $set_cc_for_build
if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ELF__
then
# Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout).
# Return netbsd for either. FIX?
os=netbsd
else
os=netbsdelf
fi
;;
*)
os=netbsd
;;
esac
# The OS release
# Debian GNU/NetBSD machines have a different userland, and
# thus, need a distinct triplet. However, they do not need
# kernel version information, so it can be replaced with a
# suitable tag, in the style of linux-gnu.
case "${UNAME_VERSION}" in
Debian*)
release='-gnu'
;;
*)
release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
;;
esac
# Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM:
# contains redundant information, the shorter form:
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used.
echo "${machine}-${os}${release}"
exit ;;
*:Bitrig:*:*)
UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'`
echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE}
exit ;;
*:OpenBSD:*:*)
UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'`
echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE}
exit ;;
*:ekkoBSD:*:*)
echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
exit ;;
*:SolidBSD:*:*)
echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE}
exit ;;
macppc:MirBSD:*:*)
echo powerpc-unknown-mirbsd${UNAME_RELEASE}
exit ;;
*:MirBSD:*:*)
echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE}
exit ;;
alpha:OSF1:*:*)
case $UNAME_RELEASE in
*4.0)
UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
;;
*5.*)
UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'`
;;
esac
# According to Compaq, /usr/sbin/psrinfo has been available on
# OSF/1 and Tru64 systems produced since 1995. I hope that
# covers most systems running today. This code pipes the CPU
# types through head -n 1, so we only detect the type of CPU 0.
ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1`
case "$ALPHA_CPU_TYPE" in
"EV4 (21064)")
UNAME_MACHINE="alpha" ;;
"EV4.5 (21064)")
UNAME_MACHINE="alpha" ;;
"LCA4 (21066/21068)")
UNAME_MACHINE="alpha" ;;
"EV5 (21164)")
UNAME_MACHINE="alphaev5" ;;
"EV5.6 (21164A)")
UNAME_MACHINE="alphaev56" ;;
"EV5.6 (21164PC)")
UNAME_MACHINE="alphapca56" ;;
"EV5.7 (21164PC)")
UNAME_MACHINE="alphapca57" ;;
"EV6 (21264)")
UNAME_MACHINE="alphaev6" ;;
"EV6.7 (21264A)")
UNAME_MACHINE="alphaev67" ;;
"EV6.8CB (21264C)")
UNAME_MACHINE="alphaev68" ;;
"EV6.8AL (21264B)")
UNAME_MACHINE="alphaev68" ;;
"EV6.8CX (21264D)")
UNAME_MACHINE="alphaev68" ;;
"EV6.9A (21264/EV69A)")
UNAME_MACHINE="alphaev69" ;;
"EV7 (21364)")
UNAME_MACHINE="alphaev7" ;;
"EV7.9 (21364A)")
UNAME_MACHINE="alphaev79" ;;
esac
# A Pn.n version is a patched version.
# A Vn.n version is a released version.
# A Tn.n version is a released field test version.
# A Xn.n version is an unreleased experimental baselevel.
# 1.2 uses "1.2" for uname -r.
echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
# Reset EXIT trap before exiting to avoid spurious non-zero exit code.
exitcode=$?
trap '' 0
exit $exitcode ;;
Alpha\ *:Windows_NT*:*)
# How do we know it's Interix rather than the generic POSIX subsystem?
# Should we change UNAME_MACHINE based on the output of uname instead
# of the specific Alpha model?
echo alpha-pc-interix
exit ;;
21064:Windows_NT:50:3)
echo alpha-dec-winnt3.5
exit ;;
Amiga*:UNIX_System_V:4.0:*)
echo m68k-unknown-sysv4
exit ;;
*:[Aa]miga[Oo][Ss]:*:*)
echo ${UNAME_MACHINE}-unknown-amigaos
exit ;;
*:[Mm]orph[Oo][Ss]:*:*)
echo ${UNAME_MACHINE}-unknown-morphos
exit ;;
*:OS/390:*:*)
echo i370-ibm-openedition
exit ;;
*:z/VM:*:*)
echo s390-ibm-zvmoe
exit ;;
*:OS400:*:*)
echo powerpc-ibm-os400
exit ;;
arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
echo arm-acorn-riscix${UNAME_RELEASE}
exit ;;
arm*:riscos:*:*|arm*:RISCOS:*:*)
echo arm-unknown-riscos
exit ;;
SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*)
echo hppa1.1-hitachi-hiuxmpp
exit ;;
Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
if test "`(/bin/universe) 2>/dev/null`" = att ; then
echo pyramid-pyramid-sysv3
else
echo pyramid-pyramid-bsd
fi
exit ;;
NILE*:*:*:dcosx)
echo pyramid-pyramid-svr4
exit ;;
DRS?6000:unix:4.0:6*)
echo sparc-icl-nx6
exit ;;
DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*)
case `/usr/bin/uname -p` in
sparc) echo sparc-icl-nx7; exit ;;
esac ;;
s390x:SunOS:*:*)
echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
sun4H:SunOS:5.*:*)
echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
echo i386-pc-auroraux${UNAME_RELEASE}
exit ;;
i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
eval $set_cc_for_build
SUN_ARCH="i386"
# If there is a compiler, see if it is configured for 64-bit objects.
# Note that the Sun cc does not turn __LP64__ into 1 like gcc does.
# This test works for both compilers.
if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
then
SUN_ARCH="x86_64"
fi
fi
echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
sun4*:SunOS:6*:*)
# According to config.sub, this is the proper way to canonicalize
# SunOS6. Hard to guess exactly what SunOS6 will be like, but
# it's likely to be more like Solaris than SunOS4.
echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
sun4*:SunOS:*:*)
case "`/usr/bin/arch -k`" in
Series*|S4*)
UNAME_RELEASE=`uname -v`
;;
esac
# Japanese Language versions have a version number like `4.1.3-JL'.
echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
exit ;;
sun3*:SunOS:*:*)
echo m68k-sun-sunos${UNAME_RELEASE}
exit ;;
sun*:*:4.2BSD:*)
UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
case "`/bin/arch`" in
sun3)
echo m68k-sun-sunos${UNAME_RELEASE}
;;
sun4)
echo sparc-sun-sunos${UNAME_RELEASE}
;;
esac
exit ;;
aushp:SunOS:*:*)
echo sparc-auspex-sunos${UNAME_RELEASE}
exit ;;
# The situation for MiNT is a little confusing. The machine name
# can be virtually everything (everything which is not
# "atarist" or "atariste" at least should have a processor
# > m68000). The system name ranges from "MiNT" over "FreeMiNT"
# to the lowercase version "mint" (or "freemint"). Finally
# the system name "TOS" denotes a system which is actually not
# MiNT. But MiNT is downward compatible to TOS, so this should
# be no problem.
atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
echo m68k-atari-mint${UNAME_RELEASE}
exit ;;
atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
echo m68k-atari-mint${UNAME_RELEASE}
exit ;;
*falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
echo m68k-atari-mint${UNAME_RELEASE}
exit ;;
milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
echo m68k-milan-mint${UNAME_RELEASE}
exit ;;
hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
echo m68k-hades-mint${UNAME_RELEASE}
exit ;;
*:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
echo m68k-unknown-mint${UNAME_RELEASE}
exit ;;
m68k:machten:*:*)
echo m68k-apple-machten${UNAME_RELEASE}
exit ;;
powerpc:machten:*:*)
echo powerpc-apple-machten${UNAME_RELEASE}
exit ;;
RISC*:Mach:*:*)
echo mips-dec-mach_bsd4.3
exit ;;
RISC*:ULTRIX:*:*)
echo mips-dec-ultrix${UNAME_RELEASE}
exit ;;
VAX*:ULTRIX*:*:*)
echo vax-dec-ultrix${UNAME_RELEASE}
exit ;;
2020:CLIX:*:* | 2430:CLIX:*:*)
echo clipper-intergraph-clix${UNAME_RELEASE}
exit ;;
mips:*:*:UMIPS | mips:*:*:RISCos)
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#ifdef __cplusplus
#include /* for printf() prototype */
int main (int argc, char *argv[]) {
#else
int main (argc, argv) int argc; char *argv[]; {
#endif
#if defined (host_mips) && defined (MIPSEB)
#if defined (SYSTYPE_SYSV)
printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_SVR4)
printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
#endif
#endif
exit (-1);
}
EOF
$CC_FOR_BUILD -o $dummy $dummy.c &&
dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` &&
SYSTEM_NAME=`$dummy $dummyarg` &&
{ echo "$SYSTEM_NAME"; exit; }
echo mips-mips-riscos${UNAME_RELEASE}
exit ;;
Motorola:PowerMAX_OS:*:*)
echo powerpc-motorola-powermax
exit ;;
Motorola:*:4.3:PL8-*)
echo powerpc-harris-powermax
exit ;;
Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*)
echo powerpc-harris-powermax
exit ;;
Night_Hawk:Power_UNIX:*:*)
echo powerpc-harris-powerunix
exit ;;
m88k:CX/UX:7*:*)
echo m88k-harris-cxux7
exit ;;
m88k:*:4*:R4*)
echo m88k-motorola-sysv4
exit ;;
m88k:*:3*:R3*)
echo m88k-motorola-sysv3
exit ;;
AViiON:dgux:*:*)
# DG/UX returns AViiON for all architectures
UNAME_PROCESSOR=`/usr/bin/uname -p`
if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
then
if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
[ ${TARGET_BINARY_INTERFACE}x = x ]
then
echo m88k-dg-dgux${UNAME_RELEASE}
else
echo m88k-dg-dguxbcs${UNAME_RELEASE}
fi
else
echo i586-dg-dgux${UNAME_RELEASE}
fi
exit ;;
M88*:DolphinOS:*:*) # DolphinOS (SVR3)
echo m88k-dolphin-sysv3
exit ;;
M88*:*:R3*:*)
# Delta 88k system running SVR3
echo m88k-motorola-sysv3
exit ;;
XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
echo m88k-tektronix-sysv3
exit ;;
Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
echo m68k-tektronix-bsd
exit ;;
*:IRIX*:*:*)
echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
exit ;;
????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
exit ;; # Note that: echo "'`uname -s`'" gives 'AIX '
i*86:AIX:*:*)
echo i386-ibm-aix
exit ;;
ia64:AIX:*:*)
if [ -x /usr/bin/oslevel ] ; then
IBM_REV=`/usr/bin/oslevel`
else
IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
fi
echo ${UNAME_MACHINE}-ibm-aix${IBM_REV}
exit ;;
*:AIX:2:3)
if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#include
main()
{
if (!__power_pc())
exit(1);
puts("powerpc-ibm-aix3.2.5");
exit(0);
}
EOF
if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy`
then
echo "$SYSTEM_NAME"
else
echo rs6000-ibm-aix3.2.5
fi
elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
echo rs6000-ibm-aix3.2.4
else
echo rs6000-ibm-aix3.2
fi
exit ;;
*:AIX:*:[4567])
IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'`
if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then
IBM_ARCH=rs6000
else
IBM_ARCH=powerpc
fi
if [ -x /usr/bin/oslevel ] ; then
IBM_REV=`/usr/bin/oslevel`
else
IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE}
fi
echo ${IBM_ARCH}-ibm-aix${IBM_REV}
exit ;;
*:AIX:*:*)
echo rs6000-ibm-aix
exit ;;
ibmrt:4.4BSD:*|romp-ibm:BSD:*)
echo romp-ibm-bsd4.4
exit ;;
ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
exit ;; # report: romp-ibm BSD 4.3
*:BOSX:*:*)
echo rs6000-bull-bosx
exit ;;
DPX/2?00:B.O.S.:*:*)
echo m68k-bull-sysv3
exit ;;
9000/[34]??:4.3bsd:1.*:*)
echo m68k-hp-bsd
exit ;;
hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
echo m68k-hp-bsd4.4
exit ;;
9000/[34678]??:HP-UX:*:*)
HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
case "${UNAME_MACHINE}" in
9000/31? ) HP_ARCH=m68000 ;;
9000/[34]?? ) HP_ARCH=m68k ;;
9000/[678][0-9][0-9])
if [ -x /usr/bin/getconf ]; then
sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null`
case "${sc_cpu_version}" in
523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0
528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1
532) # CPU_PA_RISC2_0
case "${sc_kernel_bits}" in
32) HP_ARCH="hppa2.0n" ;;
64) HP_ARCH="hppa2.0w" ;;
'') HP_ARCH="hppa2.0" ;; # HP-UX 10.20
esac ;;
esac
fi
if [ "${HP_ARCH}" = "" ]; then
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#define _HPUX_SOURCE
#include
#include
int main ()
{
#if defined(_SC_KERNEL_BITS)
long bits = sysconf(_SC_KERNEL_BITS);
#endif
long cpu = sysconf (_SC_CPU_VERSION);
switch (cpu)
{
case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
case CPU_PA_RISC2_0:
#if defined(_SC_KERNEL_BITS)
switch (bits)
{
case 64: puts ("hppa2.0w"); break;
case 32: puts ("hppa2.0n"); break;
default: puts ("hppa2.0"); break;
} break;
#else /* !defined(_SC_KERNEL_BITS) */
puts ("hppa2.0"); break;
#endif
default: puts ("hppa1.0"); break;
}
exit (0);
}
EOF
(CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy`
test -z "$HP_ARCH" && HP_ARCH=hppa
fi ;;
esac
if [ ${HP_ARCH} = "hppa2.0w" ]
then
eval $set_cc_for_build
# hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating
# 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler
# generating 64-bit code. GNU and HP use different nomenclature:
#
# $ CC_FOR_BUILD=cc ./config.guess
# => hppa2.0w-hp-hpux11.23
# $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess
# => hppa64-hp-hpux11.23
if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) |
grep -q __LP64__
then
HP_ARCH="hppa2.0w"
else
HP_ARCH="hppa64"
fi
fi
echo ${HP_ARCH}-hp-hpux${HPUX_REV}
exit ;;
ia64:HP-UX:*:*)
HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
echo ia64-hp-hpux${HPUX_REV}
exit ;;
3050*:HI-UX:*:*)
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#include
int
main ()
{
long cpu = sysconf (_SC_CPU_VERSION);
/* The order matters, because CPU_IS_HP_MC68K erroneously returns
true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
results, however. */
if (CPU_IS_PA_RISC (cpu))
{
switch (cpu)
{
case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
default: puts ("hppa-hitachi-hiuxwe2"); break;
}
}
else if (CPU_IS_HP_MC68K (cpu))
puts ("m68k-hitachi-hiuxwe2");
else puts ("unknown-hitachi-hiuxwe2");
exit (0);
}
EOF
$CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` &&
{ echo "$SYSTEM_NAME"; exit; }
echo unknown-hitachi-hiuxwe2
exit ;;
9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
echo hppa1.1-hp-bsd
exit ;;
9000/8??:4.3bsd:*:*)
echo hppa1.0-hp-bsd
exit ;;
*9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
echo hppa1.0-hp-mpeix
exit ;;
hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
echo hppa1.1-hp-osf
exit ;;
hp8??:OSF1:*:*)
echo hppa1.0-hp-osf
exit ;;
i*86:OSF1:*:*)
if [ -x /usr/sbin/sysversion ] ; then
echo ${UNAME_MACHINE}-unknown-osf1mk
else
echo ${UNAME_MACHINE}-unknown-osf1
fi
exit ;;
parisc*:Lites*:*:*)
echo hppa1.1-hp-lites
exit ;;
C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
echo c1-convex-bsd
exit ;;
C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
if getsysinfo -f scalar_acc
then echo c32-convex-bsd
else echo c2-convex-bsd
fi
exit ;;
C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
echo c34-convex-bsd
exit ;;
C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
echo c38-convex-bsd
exit ;;
C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
echo c4-convex-bsd
exit ;;
CRAY*Y-MP:*:*:*)
echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
CRAY*[A-Z]90:*:*:*)
echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
-e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \
-e 's/\.[^.]*$/.X/'
exit ;;
CRAY*TS:*:*:*)
echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
CRAY*T3E:*:*:*)
echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
CRAY*SV1:*:*:*)
echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
*:UNICOS/mp:*:*)
echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
exit ;;
F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*)
FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
exit ;;
5000:UNIX_System_V:4.*:*)
FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'`
echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
exit ;;
i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE}
exit ;;
sparc*:BSD/OS:*:*)
echo sparc-unknown-bsdi${UNAME_RELEASE}
exit ;;
*:BSD/OS:*:*)
echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
exit ;;
*:FreeBSD:*:*)
UNAME_PROCESSOR=`/usr/bin/uname -p`
case ${UNAME_PROCESSOR} in
amd64)
echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
*)
echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;;
esac
exit ;;
i*:CYGWIN*:*)
echo ${UNAME_MACHINE}-pc-cygwin
exit ;;
*:MINGW64*:*)
echo ${UNAME_MACHINE}-pc-mingw64
exit ;;
*:MINGW*:*)
echo ${UNAME_MACHINE}-pc-mingw32
exit ;;
i*:MSYS*:*)
echo ${UNAME_MACHINE}-pc-msys
exit ;;
i*:windows32*:*)
# uname -m includes "-pc" on this system.
echo ${UNAME_MACHINE}-mingw32
exit ;;
i*:PW*:*)
echo ${UNAME_MACHINE}-pc-pw32
exit ;;
*:Interix*:*)
case ${UNAME_MACHINE} in
x86)
echo i586-pc-interix${UNAME_RELEASE}
exit ;;
authenticamd | genuineintel | EM64T)
echo x86_64-unknown-interix${UNAME_RELEASE}
exit ;;
IA64)
echo ia64-unknown-interix${UNAME_RELEASE}
exit ;;
esac ;;
[345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
echo i${UNAME_MACHINE}-pc-mks
exit ;;
8664:Windows_NT:*)
echo x86_64-pc-mks
exit ;;
i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
# How do we know it's Interix rather than the generic POSIX subsystem?
# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
# UNAME_MACHINE based on the output of uname instead of i386?
echo i586-pc-interix
exit ;;
i*:UWIN*:*)
echo ${UNAME_MACHINE}-pc-uwin
exit ;;
amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
echo x86_64-unknown-cygwin
exit ;;
p*:CYGWIN*:*)
echo powerpcle-unknown-cygwin
exit ;;
prep*:SunOS:5.*:*)
echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
*:GNU:*:*)
# the GNU system
echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
exit ;;
*:GNU/*:*:*)
# other systems with GNU libc and userland
echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC}
exit ;;
i*86:Minix:*:*)
echo ${UNAME_MACHINE}-pc-minix
exit ;;
aarch64:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
aarch64_be:Linux:*:*)
UNAME_MACHINE=aarch64_be
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
alpha:Linux:*:*)
case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
PCA57) UNAME_MACHINE=alphapca56 ;;
EV6) UNAME_MACHINE=alphaev6 ;;
EV67) UNAME_MACHINE=alphaev67 ;;
EV68*) UNAME_MACHINE=alphaev68 ;;
esac
objdump --private-headers /bin/sh | grep -q ld.so.1
if test "$?" = 0 ; then LIBC="gnulibc1" ; fi
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
arc:Linux:*:* | arceb:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
arm*:Linux:*:*)
eval $set_cc_for_build
if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_EABI__
then
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
else
if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \
| grep -q __ARM_PCS_VFP
then
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi
else
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf
fi
fi
exit ;;
avr32*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
cris:Linux:*:*)
echo ${UNAME_MACHINE}-axis-linux-${LIBC}
exit ;;
crisv32:Linux:*:*)
echo ${UNAME_MACHINE}-axis-linux-${LIBC}
exit ;;
frv:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
hexagon:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
i*86:Linux:*:*)
echo ${UNAME_MACHINE}-pc-linux-${LIBC}
exit ;;
ia64:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
m32r*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
m68*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
mips:Linux:*:* | mips64:Linux:*:*)
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#undef CPU
#undef ${UNAME_MACHINE}
#undef ${UNAME_MACHINE}el
#if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL)
CPU=${UNAME_MACHINE}el
#else
#if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB)
CPU=${UNAME_MACHINE}
#else
CPU=
#endif
#endif
EOF
eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`
test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; }
;;
or1k:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
or32:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
padre:Linux:*:*)
echo sparc-unknown-linux-${LIBC}
exit ;;
parisc64:Linux:*:* | hppa64:Linux:*:*)
echo hppa64-unknown-linux-${LIBC}
exit ;;
parisc:Linux:*:* | hppa:Linux:*:*)
# Look for CPU level
case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
PA7*) echo hppa1.1-unknown-linux-${LIBC} ;;
PA8*) echo hppa2.0-unknown-linux-${LIBC} ;;
*) echo hppa-unknown-linux-${LIBC} ;;
esac
exit ;;
ppc64:Linux:*:*)
echo powerpc64-unknown-linux-${LIBC}
exit ;;
ppc:Linux:*:*)
echo powerpc-unknown-linux-${LIBC}
exit ;;
ppc64le:Linux:*:*)
echo powerpc64le-unknown-linux-${LIBC}
exit ;;
ppcle:Linux:*:*)
echo powerpcle-unknown-linux-${LIBC}
exit ;;
s390:Linux:*:* | s390x:Linux:*:*)
echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
exit ;;
sh64*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
sh*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
sparc:Linux:*:* | sparc64:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
tile*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
vax:Linux:*:*)
echo ${UNAME_MACHINE}-dec-linux-${LIBC}
exit ;;
x86_64:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
xtensa*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-${LIBC}
exit ;;
i*86:DYNIX/ptx:4*:*)
# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
# earlier versions are messed up and put the nodename in both
# sysname and nodename.
echo i386-sequent-sysv4
exit ;;
i*86:UNIX_SV:4.2MP:2.*)
# Unixware is an offshoot of SVR4, but it has its own version
# number series starting with 2...
# I am not positive that other SVR4 systems won't match this,
# I just have to hope. -- rms.
# Use sysv4.2uw... so that sysv4* matches it.
echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION}
exit ;;
i*86:OS/2:*:*)
# If we were able to find `uname', then EMX Unix compatibility
# is probably installed.
echo ${UNAME_MACHINE}-pc-os2-emx
exit ;;
i*86:XTS-300:*:STOP)
echo ${UNAME_MACHINE}-unknown-stop
exit ;;
i*86:atheos:*:*)
echo ${UNAME_MACHINE}-unknown-atheos
exit ;;
i*86:syllable:*:*)
echo ${UNAME_MACHINE}-pc-syllable
exit ;;
i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*)
echo i386-unknown-lynxos${UNAME_RELEASE}
exit ;;
i*86:*DOS:*:*)
echo ${UNAME_MACHINE}-pc-msdosdjgpp
exit ;;
i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL}
else
echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL}
fi
exit ;;
i*86:*:5:[678]*)
# UnixWare 7.x, OpenUNIX and OpenServer 6.
case `/bin/uname -X | grep "^Machine"` in
*486*) UNAME_MACHINE=i486 ;;
*Pentium) UNAME_MACHINE=i586 ;;
*Pent*|*Celeron) UNAME_MACHINE=i686 ;;
esac
echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}
exit ;;
i*86:*:3.2:*)
if test -f /usr/options/cb.name; then
UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then
UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')`
(/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486
(/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \
&& UNAME_MACHINE=i586
(/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \
&& UNAME_MACHINE=i686
(/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \
&& UNAME_MACHINE=i686
echo ${UNAME_MACHINE}-pc-sco$UNAME_REL
else
echo ${UNAME_MACHINE}-pc-sysv32
fi
exit ;;
pc:*:*:*)
# Left here for compatibility:
# uname -m prints for DJGPP always 'pc', but it prints nothing about
# the processor, so we play safe by assuming i586.
# Note: whatever this is, it MUST be the same as what config.sub
# prints for the "djgpp" host, or else GDB configury will decide that
# this is a cross-build.
echo i586-pc-msdosdjgpp
exit ;;
Intel:Mach:3*:*)
echo i386-pc-mach3
exit ;;
paragon:*:*:*)
echo i860-intel-osf1
exit ;;
i860:*:4.*:*) # i860-SVR4
if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
else # Add other i860-SVR4 vendors below as they are discovered.
echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
fi
exit ;;
mini*:CTIX:SYS*5:*)
# "miniframe"
echo m68010-convergent-sysv
exit ;;
mc68k:UNIX:SYSTEM5:3.51m)
echo m68k-convergent-sysv
exit ;;
M680?0:D-NIX:5.3:*)
echo m68k-diab-dnix
exit ;;
M68*:*:R3V[5678]*:*)
test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;;
3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0)
OS_REL=''
test -r /etc/.relid \
&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
&& { echo i486-ncr-sysv4.3${OS_REL}; exit; }
/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
&& { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
&& { echo i486-ncr-sysv4; exit; } ;;
NCR*:*:4.2:* | MPRAS*:*:4.2:*)
OS_REL='.3'
test -r /etc/.relid \
&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
&& { echo i486-ncr-sysv4.3${OS_REL}; exit; }
/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
&& { echo i586-ncr-sysv4.3${OS_REL}; exit; }
/bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \
&& { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;;
m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*)
echo m68k-unknown-lynxos${UNAME_RELEASE}
exit ;;
mc68030:UNIX_System_V:4.*:*)
echo m68k-atari-sysv4
exit ;;
TSUNAMI:LynxOS:2.*:*)
echo sparc-unknown-lynxos${UNAME_RELEASE}
exit ;;
rs6000:LynxOS:2.*:*)
echo rs6000-unknown-lynxos${UNAME_RELEASE}
exit ;;
PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*)
echo powerpc-unknown-lynxos${UNAME_RELEASE}
exit ;;
SM[BE]S:UNIX_SV:*:*)
echo mips-dde-sysv${UNAME_RELEASE}
exit ;;
RM*:ReliantUNIX-*:*:*)
echo mips-sni-sysv4
exit ;;
RM*:SINIX-*:*:*)
echo mips-sni-sysv4
exit ;;
*:SINIX-*:*:*)
if uname -p 2>/dev/null >/dev/null ; then
UNAME_MACHINE=`(uname -p) 2>/dev/null`
echo ${UNAME_MACHINE}-sni-sysv4
else
echo ns32k-sni-sysv
fi
exit ;;
PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
# says
echo i586-unisys-sysv4
exit ;;
*:UNIX_System_V:4*:FTX*)
# From Gerald Hewes .
# How about differentiating between stratus architectures? -djm
echo hppa1.1-stratus-sysv4
exit ;;
*:*:*:FTX*)
# From seanf@swdc.stratus.com.
echo i860-stratus-sysv4
exit ;;
i*86:VOS:*:*)
# From Paul.Green@stratus.com.
echo ${UNAME_MACHINE}-stratus-vos
exit ;;
*:VOS:*:*)
# From Paul.Green@stratus.com.
echo hppa1.1-stratus-vos
exit ;;
mc68*:A/UX:*:*)
echo m68k-apple-aux${UNAME_RELEASE}
exit ;;
news*:NEWS-OS:6*:*)
echo mips-sony-newsos6
exit ;;
R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
if [ -d /usr/nec ]; then
echo mips-nec-sysv${UNAME_RELEASE}
else
echo mips-unknown-sysv${UNAME_RELEASE}
fi
exit ;;
BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only.
echo powerpc-be-beos
exit ;;
BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only.
echo powerpc-apple-beos
exit ;;
BePC:BeOS:*:*) # BeOS running on Intel PC compatible.
echo i586-pc-beos
exit ;;
BePC:Haiku:*:*) # Haiku running on Intel PC compatible.
echo i586-pc-haiku
exit ;;
x86_64:Haiku:*:*)
echo x86_64-unknown-haiku
exit ;;
SX-4:SUPER-UX:*:*)
echo sx4-nec-superux${UNAME_RELEASE}
exit ;;
SX-5:SUPER-UX:*:*)
echo sx5-nec-superux${UNAME_RELEASE}
exit ;;
SX-6:SUPER-UX:*:*)
echo sx6-nec-superux${UNAME_RELEASE}
exit ;;
SX-7:SUPER-UX:*:*)
echo sx7-nec-superux${UNAME_RELEASE}
exit ;;
SX-8:SUPER-UX:*:*)
echo sx8-nec-superux${UNAME_RELEASE}
exit ;;
SX-8R:SUPER-UX:*:*)
echo sx8r-nec-superux${UNAME_RELEASE}
exit ;;
Power*:Rhapsody:*:*)
echo powerpc-apple-rhapsody${UNAME_RELEASE}
exit ;;
*:Rhapsody:*:*)
echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
exit ;;
*:Darwin:*:*)
UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
eval $set_cc_for_build
if test "$UNAME_PROCESSOR" = unknown ; then
UNAME_PROCESSOR=powerpc
fi
if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
then
case $UNAME_PROCESSOR in
i386) UNAME_PROCESSOR=x86_64 ;;
powerpc) UNAME_PROCESSOR=powerpc64 ;;
esac
fi
fi
echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}
exit ;;
*:procnto*:*:* | *:QNX:[0123456789]*:*)
UNAME_PROCESSOR=`uname -p`
if test "$UNAME_PROCESSOR" = "x86"; then
UNAME_PROCESSOR=i386
UNAME_MACHINE=pc
fi
echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE}
exit ;;
*:QNX:*:4*)
echo i386-pc-qnx
exit ;;
NEO-?:NONSTOP_KERNEL:*:*)
echo neo-tandem-nsk${UNAME_RELEASE}
exit ;;
NSE-*:NONSTOP_KERNEL:*:*)
echo nse-tandem-nsk${UNAME_RELEASE}
exit ;;
NSR-?:NONSTOP_KERNEL:*:*)
echo nsr-tandem-nsk${UNAME_RELEASE}
exit ;;
*:NonStop-UX:*:*)
echo mips-compaq-nonstopux
exit ;;
BS2000:POSIX*:*:*)
echo bs2000-siemens-sysv
exit ;;
DS/*:UNIX_System_V:*:*)
echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE}
exit ;;
*:Plan9:*:*)
# "uname -m" is not consistent, so use $cputype instead. 386
# is converted to i386 for consistency with other x86
# operating systems.
if test "$cputype" = "386"; then
UNAME_MACHINE=i386
else
UNAME_MACHINE="$cputype"
fi
echo ${UNAME_MACHINE}-unknown-plan9
exit ;;
*:TOPS-10:*:*)
echo pdp10-unknown-tops10
exit ;;
*:TENEX:*:*)
echo pdp10-unknown-tenex
exit ;;
KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*)
echo pdp10-dec-tops20
exit ;;
XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*)
echo pdp10-xkl-tops20
exit ;;
*:TOPS-20:*:*)
echo pdp10-unknown-tops20
exit ;;
*:ITS:*:*)
echo pdp10-unknown-its
exit ;;
SEI:*:*:SEIUX)
echo mips-sei-seiux${UNAME_RELEASE}
exit ;;
*:DragonFly:*:*)
echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
exit ;;
*:*VMS:*:*)
UNAME_MACHINE=`(uname -p) 2>/dev/null`
case "${UNAME_MACHINE}" in
A*) echo alpha-dec-vms ; exit ;;
I*) echo ia64-dec-vms ; exit ;;
V*) echo vax-dec-vms ; exit ;;
esac ;;
*:XENIX:*:SysV)
echo i386-pc-xenix
exit ;;
i*86:skyos:*:*)
echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//'
exit ;;
i*86:rdos:*:*)
echo ${UNAME_MACHINE}-pc-rdos
exit ;;
i*86:AROS:*:*)
echo ${UNAME_MACHINE}-pc-aros
exit ;;
x86_64:VMkernel:*:*)
echo ${UNAME_MACHINE}-unknown-esx
exit ;;
esac
eval $set_cc_for_build
cat >$dummy.c <
# include
#endif
main ()
{
#if defined (sony)
#if defined (MIPSEB)
/* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
I don't know.... */
printf ("mips-sony-bsd\n"); exit (0);
#else
#include
printf ("m68k-sony-newsos%s\n",
#ifdef NEWSOS4
"4"
#else
""
#endif
); exit (0);
#endif
#endif
#if defined (__arm) && defined (__acorn) && defined (__unix)
printf ("arm-acorn-riscix\n"); exit (0);
#endif
#if defined (hp300) && !defined (hpux)
printf ("m68k-hp-bsd\n"); exit (0);
#endif
#if defined (NeXT)
#if !defined (__ARCHITECTURE__)
#define __ARCHITECTURE__ "m68k"
#endif
int version;
version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
if (version < 4)
printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
else
printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
exit (0);
#endif
#if defined (MULTIMAX) || defined (n16)
#if defined (UMAXV)
printf ("ns32k-encore-sysv\n"); exit (0);
#else
#if defined (CMU)
printf ("ns32k-encore-mach\n"); exit (0);
#else
printf ("ns32k-encore-bsd\n"); exit (0);
#endif
#endif
#endif
#if defined (__386BSD__)
printf ("i386-pc-bsd\n"); exit (0);
#endif
#if defined (sequent)
#if defined (i386)
printf ("i386-sequent-dynix\n"); exit (0);
#endif
#if defined (ns32000)
printf ("ns32k-sequent-dynix\n"); exit (0);
#endif
#endif
#if defined (_SEQUENT_)
struct utsname un;
uname(&un);
if (strncmp(un.version, "V2", 2) == 0) {
printf ("i386-sequent-ptx2\n"); exit (0);
}
if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
printf ("i386-sequent-ptx1\n"); exit (0);
}
printf ("i386-sequent-ptx\n"); exit (0);
#endif
#if defined (vax)
# if !defined (ultrix)
# include
# if defined (BSD)
# if BSD == 43
printf ("vax-dec-bsd4.3\n"); exit (0);
# else
# if BSD == 199006
printf ("vax-dec-bsd4.3reno\n"); exit (0);
# else
printf ("vax-dec-bsd\n"); exit (0);
# endif
# endif
# else
printf ("vax-dec-bsd\n"); exit (0);
# endif
# else
printf ("vax-dec-ultrix\n"); exit (0);
# endif
#endif
#if defined (alliant) && defined (i860)
printf ("i860-alliant-bsd\n"); exit (0);
#endif
exit (1);
}
EOF
$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` &&
{ echo "$SYSTEM_NAME"; exit; }
# Apollos put the system type in the environment.
test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; }
# Convex versions that predate uname can use getsysinfo(1)
if [ -x /usr/convex/getsysinfo ]
then
case `getsysinfo -f cpu_type` in
c1*)
echo c1-convex-bsd
exit ;;
c2*)
if getsysinfo -f scalar_acc
then echo c32-convex-bsd
else echo c2-convex-bsd
fi
exit ;;
c34*)
echo c34-convex-bsd
exit ;;
c38*)
echo c38-convex-bsd
exit ;;
c4*)
echo c4-convex-bsd
exit ;;
esac
fi
cat >&2 < in order to provide the needed
information to handle your system.
config.guess timestamp = $timestamp
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`
/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null`
/bin/uname -X = `(/bin/uname -X) 2>/dev/null`
hostinfo = `(hostinfo) 2>/dev/null`
/bin/universe = `(/bin/universe) 2>/dev/null`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null`
/bin/arch = `(/bin/arch) 2>/dev/null`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null`
UNAME_MACHINE = ${UNAME_MACHINE}
UNAME_RELEASE = ${UNAME_RELEASE}
UNAME_SYSTEM = ${UNAME_SYSTEM}
UNAME_VERSION = ${UNAME_VERSION}
EOF
exit 1
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
# End:
arpack-ng-3.1.5/EXAMPLES/ 0000755 0001750 0001750 00000000000 12277671461 011617 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/NONSYM/ 0000755 0001750 0001750 00000000000 12277671461 012642 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv4.f 0000644 0001750 0001750 00000046330 12277373057 014157 0000000 0000000 program sndrv4
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue
c problem.
c
c We implement example four of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A and B are derived from the finite element discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c
c ... The shift sigma is a real number.
c
c ... OP = inv[A-SIGMA*M]*M and B = M.
c
c ... Use mode 3 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal linear system solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn), workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Real
& tol, h, s,
& sigmar, sigmai, s1, s2, s3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& sdot, snrm2, slapy2
external sdot, snrm2, slapy2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two, six, rho
common /convct/ rho
parameter (one = 1.0E+0, zero = 0.0E+0,
& two = 2.0E+0, six = 6.0E+0)
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to SIGMAR) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMAR to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = one
sigmai = zero
c
c %--------------------------------------------------%
c | Construct C = A - SIGMA*M in real arithmetic, |
c | and factor C in real arithmetic (using LAPACK |
c | subroutine sgttrf). 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 | interval [0, 1] with zero Dirichlet boundary |
c | condition. The matrix M is the mass matrix |
c | formed by using piecewise linear elements on |
c | [0,1]. |
c %--------------------------------------------------%
c
rho = 1.0E+1
h = one / real(n+1)
s = rho / two
c
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
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call sgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 SNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force starting vector into the range |
c | of OP. The user should supply his/her |
c | own matrix vector multiplication routine |
c | and a linear system solver. The matrix |
c | vector multiplication routine should take |
c | workd(ipntr(1)) as the input. The final |
c | result should be returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
call sgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(3)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call scopy( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j+1), mx)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV4 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv4. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Real
& 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) ) / six
do 10 j = 2,n-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) ) / six
c
h = one / real(n+1)
call sscal(n, h, w, 1)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), one, two, dd, dl, du, s, h, rho
common /convct/ rho
parameter (one = 1.0E+0, two = 2.0E+0)
c
c Compute the matrix vector multiplication y<---A*x
c where A is obtained from the finite element discretization of the
c 1-dimensional convection diffusion operator
c d^u/dx^2 + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c This routine is only used in residual calculation.
c
h = one / real(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv3.f 0000644 0001750 0001750 00000041246 12277373057 014157 0000000 0000000 program sndrv3
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A and B are derived from the finite element discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c
c ... So OP = inv[M]*A and B = M.
c
c ... Use mode 2 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c spttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c spttrs LAPACK symmetric positive definite tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Real
& tol, sigmar, sigmai, h
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one
parameter (zero = 0.0E+0, one = 1.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Real
& snrm2, slapy2
external saxpy, snrm2, spttrf, spttrs, slapy2
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %------------------------------------------------%
c | M is the mass matrix formed by using piecewise |
c | linear elements on [0,1]. |
c %------------------------------------------------%
c
h = one / real(n+1)
do 20 j = 1, n-1
md(j) = 4.0E+0*h
me(j) = one*h
20 continue
md(n) = 4.0E+0*h
c
call spttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 SNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call spttrs(n, 1, md, me, workd(ipntr(2)), n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j+1), mx)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)**2
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV3 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv3. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), one, two, dd, dl, du, s, h, rho
parameter ( rho = 1.0E+1, one = 1.0E+0,
& two = 2.0E+0)
c
c Compute the matrix vector multiplication y<---A*x
c where A is stiffness matrix obtained from the finite element
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 Dirichlet boundary condition using
c linear elements.
c
h = one / real(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
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)
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear
c elements on [0,1].
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
c
h = one / real(n+1)
call sscal(n, h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv5.f 0000644 0001750 0001750 00000052246 12277373503 014140 0000000 0000000 program dndrv5
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example five of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-5
c
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode
c The matrix A is the tridiagonal matrix with 2 on the diagonal,
c -2 on the subdiagonal and 3 on the superdiagonal. The matrix M
c is the tridiagonal matrix with 4 on the diagonal and 1 on the
c off-diagonals.
c ... The shift sigma is a complex number (sigmar, sigmai).
c ... OP = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M and B = M.
c ... Use mode 3 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c zgttrf LAPACK complex matrix factorization routine.
c zgttrs LAPACK complex linear system solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c ddot Level 1 BLAS that computes the dot product of two vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector
c av Matrix vector subroutine that computes A*x.
c mv Matrix vector subroutine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=98, maxncv=100,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
Complex*16
& cdd(maxn), cdl(maxn), cdu(maxn),
& cdu2(maxn), ctemp(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Double precision
& tol, numr, numi, denr, deni, sigmar, sigmai
Complex*16
& c1, c2, c3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
external zgttrf, zgttrs
Double precision
& ddot, dnrm2, dlapy2
external ddot, dnrm2, dlapy2
c
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %--------------------%
c | Intrinsic Function |
c %--------------------%
c
intrinsic dble, dcmplx, abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to the shift (SIGMAR,SIGMAI)) to be approximated. |
c | Since the shift-invert mode is used, WHICH is set |
c | to 'LM'. The user can modify NEV, NCV, SIGMAR, |
c | SIGMAI to solve problems of different sizes, and |
c | to get different parts of the spectrum. However, |
c | The following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 98
ncv = 100
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0D-1
sigmai = 6.0D-1
c
c %---------------------------------------------------%
c | Construct C = A - (SIGMAR,SIGMAI)*M in complex |
c | arithmetic, and factor C in complex arithmetic |
c | (using LAPACK subroutine zgttrf). The matrix A is |
c | chosen to be the tridiagonal matrix with -2 on |
c | the subdiagonal, 2 on the diagonal and 3 on the |
c | superdiagonal. The matrix M is chosen to the |
c | symmetric tridiagonal matrix with 4 on the |
c | diagonal and 1 on the off-diagonals. |
c %---------------------------------------------------%
c
c1 = dcmplx( 0.0D+0, 0.0D+0)
c3 = dcmplx( 0.0D+0, 0.0D+0)
c
do 10 j = 1, n-1
cdl(j) = c1
cdd(j) = dcmplx( j-sigmar, sigmai)
cdu(j) = c3
10 continue
cdd(n) = dcmplx( n-sigmar, sigmai)
c
call zgttrf(n, cdl, cdd, cdu, cdu2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV5.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 3 of DNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | to force starting vector into the range of OP. The |
c | user should supply his/her own matrix vector |
c | multiplication routine and a complex linear system |
c | solver. The matrix vector multiplication routine |
c | should take workd(ipntr(1)) as the input. The final |
c | result (a real vector) should be returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
do 30 j = 1, n
ctemp(j) = dcmplx(workd(ipntr(2)+j-1))
30 continue
c
call zgttrs('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV5.'
print*, ' '
go to 9000
end if
do 40 j = 1, n
workd(ipntr(2)+j-1) = dble(ctemp(j))
40 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | M*x has been saved in workd(ipntr(3)). The user only |
c | needs the complex linear system solver here that |
c | takes complex[workd(ipntr(3))] as input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------------------%
c
do 50 j = 1,n
ctemp(j) = dcmplx(workd(ipntr(3)+j-1))
50 continue
call zgttrs ('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV5.'
print*, ' '
go to 9000
end if
do 60 j = 1, n
workd(ipntr(2)+j-1) = dble(ctemp(j))
60 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c
c %------------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %------------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 70 j=1,nconv
c
c %-------------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original problem.|
c %-------------------------------------%
c
if ( d(j,2) .eq. zero ) then
c
c %---------------------------%
c | Eigenvalue is real. |
c | Compute d = x'(Ax)/x'(Mx).|
c %---------------------------%
c
call av(n, v(1,j), ax )
numr = ddot(n, v(1,j), 1, ax, 1)
call mv(n, v(1,j), ax )
denr = ddot(n, v(1,j), 1, ax, 1)
d(j,1) = numr / denr
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %----------------%
c | Compute x'(Ax) |
c %----------------%
call av(n, v(1,j), ax )
numr = ddot(n, v(1,j), 1, ax, 1)
numi = ddot(n, v(1,j+1), 1, ax, 1)
call av(n, v(1,j+1), ax)
numr = numr + ddot(n,v(1,j+1),1,ax,1)
numi = -numi + ddot(n,v(1,j),1,ax,1)
c
c %----------------%
c | Compute x'(Mx) |
c %----------------%
c
call mv(n, v(1,j), ax )
denr = ddot(n, v(1,j), 1, ax, 1)
deni = ddot(n, v(1,j+1), 1, ax, 1)
call mv(n, v(1,j+1), ax)
denr = denr + ddot(n,v(1,j+1),1,ax,1)
deni = -deni + ddot(n,v(1,j),1, ax,1)
c
c %----------------%
c | d=x'(Ax)/x'(Mx)|
c %----------------%
c
d(j,1) = (numr*denr+numi*deni) /
& dlapy2(denr, deni)
d(j,2) = (numi*denr-numr*deni) /
& dlapy2(denr, deni)
first = .false.
c
else
c
c %------------------------------%
c | Get the second eigenvalue of |
c | the conjugate pair by taking |
c | the conjugate of the last |
c | eigenvalue computed. |
c %------------------------------%
c
d(j,1) = d(j-1,1)
d(j,2) = -d(j-1,2)
first = .true.
c
end if
c
70 continue
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
first = .true.
do 80 j=1, nconv
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
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,3) = dnrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
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)
call mv(n, v(1,j+1), mx)
call daxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = dnrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call daxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
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
first = .true.
end if
c
80 continue
c
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV5 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv5. |
c %---------------------------%
c
9000 continue
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Double precision v(n), w(n)
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n diagonal matrix with 1 on thediagonal
c
do 10 j = 1,n
w(j) = v(j)
10 continue
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Double precision v(n), w(n)
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n diagonal matrix with j on the
c diagonal, where j is row's number
c
do 10 j = 1,n
w(j) = j*v(j)
10 continue
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv4.f 0000644 0001750 0001750 00000046440 12277373057 014142 0000000 0000000 program dndrv4
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue
c problem.
c
c We implement example four of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A and B are derived from the finite element discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c
c ... The shift sigma is a real number.
c
c ... OP = inv[A-SIGMA*M]*M and B = M.
c
c ... Use mode 3 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dgttrf LAPACK tridiagonal factorization routine.
c dgttrs LAPACK tridiagonal linear system solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dcopy Level 1 BLAS that copies one vector to another.
c ddot Level 1 BLAS that computes the dot product of two vectors.
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn), workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Double precision
& tol, h, s,
& sigmar, sigmai, s1, s2, s3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& ddot, dnrm2, dlapy2
external ddot, dnrm2, dlapy2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two, six, rho
common /convct/ rho
parameter (one = 1.0D+0, zero = 0.0D+0,
& two = 2.0D+0, six = 6.0D+0)
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to SIGMAR) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMAR to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = one
sigmai = zero
c
c %--------------------------------------------------%
c | Construct C = A - SIGMA*M in real arithmetic, |
c | and factor C in real arithmetic (using LAPACK |
c | subroutine dgttrf). 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 | interval [0, 1] with zero Dirichlet boundary |
c | condition. The matrix M is the mass matrix |
c | formed by using piecewise linear elements on |
c | [0,1]. |
c %--------------------------------------------------%
c
rho = 1.0D+1
h = one / dble(n+1)
s = rho / two
c
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
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call dgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 DNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force starting vector into the range |
c | of OP. The user should supply his/her |
c | own matrix vector multiplication routine |
c | and a linear system solver. The matrix |
c | vector multiplication routine should take |
c | workd(ipntr(1)) as the input. The final |
c | result should be returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
call dgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(3)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call dcopy( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
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,3) = dnrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
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)
call mv(n, v(1,j+1), mx)
call daxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = dnrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call daxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
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
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV4 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv4. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Double precision
& 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) ) / six
do 10 j = 2,n-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) ) / six
c
h = one / dble(n+1)
call dscal(n, h, w, 1)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, dd, dl, du, s, h, rho
common /convct/ rho
parameter (one = 1.0D+0, two = 2.0D+0)
c
c Compute the matrix vector multiplication y<---A*x
c where A is obtained from the finite element discretization of the
c 1-dimensional convection diffusion operator
c d^u/dx^2 + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c This routine is only used in residual calculation.
c
h = one / dble(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv2.f 0000644 0001750 0001750 00000037465 12277373057 014166 0000000 0000000 program sndrv2
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a standard nonsymmetric eigenvalue problem.
c
c We implement example two of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the centered difference discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition.
c
c ... The shift sigma is a real number.
c
c ... OP = inv[A-sigma*I] and B = I.
c
c ... Use mode 3 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Real
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv, maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Real
& tol, h, s,
& sigmar, sigmai, s1, s2, s3
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two, rho
common /convct/ rho
parameter (one = 1.0E+0, zero = 0.0E+0,
& two = 2.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& sdot, snrm2, slapy2
external sgttrf, sgttrs, sdot, snrm2, slapy2
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = |
c | 'I'). NEV is the number of eigenvalues (closest |
c | to the shift SIGMAR) to be approximated. Since |
c | the shift-invert mode is used, WHICH is set to |
c | 'LM'. The user can modify NEV, NCV, SIGMAR to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 1.0E+0
sigmai = 0.0E+0
c
c %----------------------------------------------------%
c | Construct C = A - SIGMA*I in real arithmetic, and |
c | factor C in real arithmetic using LAPACK |
c | subroutine sgttrf. The matrix A is chosen to be |
c | the tridiagonal matrix derived from standard |
c | central difference of the 1-d convection diffusion |
c | operator u" + rho*u' on the interval [0, 1] with |
c | zero Dirichlet boundary condition. |
c %----------------------------------------------------%
c
rho = 1.0E+1
h = one / real(n+1)
s = rho*h / two
c
s1 = -one-s
s2 = two - sigmar
s3 = -one+s
c
do 10 j = 1, n-1
dl(j) = s1
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call sgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 SNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if ( ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*I]*x |
c | The user should supply his/her own linear |
c | system solver here that takes |
c | workd(ipntr(1)) as the input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------%
c
call scopy( n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
c
call sgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV2 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c-------------------------------------------------------------------
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), rho, two, one, dd, dl, du, s, h
common /convct/ rho
parameter (one = 1.0E+0, two = 2.0E+0 )
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived from
c the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
c
h = one / real(n+1)
s = rho *h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv6.f 0000644 0001750 0001750 00000053355 12277373057 014166 0000000 0000000 program sndrv6
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example six of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-6
c
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode
c The matrix A is the tridiagonal matrix with 2 on the diagonal,
c -2 on the subdiagonal and 3 on the superdiagonal. The matrix M
c is the tridiagonal matrix with 4 on the diagonal and 1 on the
c off-diagonals.
c ... The shift sigma is a complex number (sigmar, sigmai).
c ... OP = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M and B = M.
c ... Use mode 4 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgttrf LAPACK complex matrix factorization routine.
c cgttrs LAPACK complex linear system solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector subroutine that computes A*x.
c mv Matrix vector subroutine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
Complex
& cdd(maxn), cdl(maxn), cdu(maxn),
& cdu2(maxn), ctemp(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Real
& tol, numr, numi, denr, deni, sigmar, sigmai
Complex
& c1, c2, c3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
external cgttrf, cgttrs
Real
& sdot, snrm2, slapy2
external sdot, snrm2, slapy2
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %--------------------%
c | Intrinsic Function |
c %--------------------%
c
intrinsic aimag, cmplx, abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to the shift (SIGMAR,SIGMAI)) to be approximated. |
c | Since the shift-invert mode is used, WHICH is set |
c | to 'LM'. The user can modify NEV, NCV, SIGMA to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0E-1
sigmai = 6.0E-1
c
c %----------------------------------------------------%
c | Construct C = A - (SIGMAR,SIGMAI)*M in complex |
c | arithmetic, and factor C in complex arithmetic |
c | (using LAPACK subroutine cgttrf). The matrix A is |
c | chosen to be the tridiagonal matrix with -2 on the |
c | subdiagonal, 2 on the diagonal and 3 on the |
c | superdiagonal. The matrix M is chosen to be the |
c | symmetric tridiagonal matrix with 4 on the |
c | diagonal and 1 on the off-diagonals. |
c %----------------------------------------------------%
c
c1 = cmplx(-2.0E+0-sigmar, -sigmai)
c2 = cmplx( 2.0E+0-4.0E+0*sigmar, -4.0E+0*sigmai)
c3 = cmplx( 3.0E+0-sigmar, -sigmai)
c
do 10 j = 1, n-1
cdl(j) = c1
cdd(j) = c2
cdu(j) = c3
10 continue
cdd(n) = c2
c
call cgttrf(n, cdl, cdd, cdu, cdu2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV6.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 3 of SNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %------------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | to force starting vector into the range of OP. The user |
c | should supply his/her own matrix vector multiplication |
c | routine and a complex linear system solver. The matrix |
c | vector multiplication routine should take workd(ipntr(1)) |
c | as the input. The final result (a real vector) should be |
c | returned to workd(ipntr(2)). |
c %------------------------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
do 30 j = 1, n
ctemp(j) = cmplx(workd(ipntr(2)+j-1))
30 continue
c
call cgttrs('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, maxn, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV6.'
print*, ' '
go to 9000
end if
do 40 j = 1, n
workd(ipntr(2)+j-1) = aimag(ctemp(j))
40 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %------------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | M*x has been saved in workd(ipntr(3)). The user only need |
c | the complex linear system solver here that takes |
c | complex[workd(ipntr(3))] as input, and returns the result |
c | to workd(ipntr(2)). |
c %------------------------------------------------------------%
c
do 50 j = 1,n
ctemp(j) = cmplx(workd(ipntr(3)+j-1))
50 continue
call cgttrs ('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, maxn, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV6.'
print*, ' '
go to 9000
end if
do 60 j = 1, n
workd(ipntr(2)+j-1) = aimag(ctemp(j))
60 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 70 j=1, nconv
c
c %-------------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original problem.|
c %-------------------------------------%
c
if ( d(j,2) .eq. zero) then
c
c %----------------------------%
c | Eigenvalue is real. |
c | Compute d = x'(Ax)/x'(Mx). |
c %----------------------------%
c
call av(n, v(1,j), ax )
numr = sdot(n, v(1,j), 1, ax, 1)
call mv(n, v(1,j), ax )
denr = sdot(n, v(1,j), 1, ax, 1)
d(j,1) = numr / denr
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %----------------%
c | Compute x'(Ax) |
c %----------------%
c
call av(n, v(1,j), ax )
numr = sdot(n, v(1,j), 1, ax, 1)
numi = sdot(n, v(1,j+1), 1, ax, 1)
call av(n, v(1,j+1), ax)
numr = numr + sdot(n,v(1,j+1),1,ax,1)
numi = -numi + sdot(n,v(1,j),1,ax,1)
c
c %----------------%
c | Compute x'(Mx) |
c %----------------%
c
call mv(n, v(1,j), ax )
denr = sdot(n, v(1,j), 1, ax, 1)
deni = sdot(n, v(1,j+1), 1, ax, 1)
call mv(n, v(1,j+1), ax)
denr = denr + sdot(n,v(1,j+1),1,ax,1)
deni = -deni + sdot(n,v(1,j),1, ax,1)
c
c %----------------%
c | d=x'(Ax)/x'(Mx)|
c %----------------%
c
d(j,1) = (numr*denr+numi*deni) /
& slapy2(denr, deni)
d(j,2) = (numi*denr-numr*deni) /
& slapy2(denr, deni)
first = .false.
c
else
c
c %------------------------------%
c | Get the second eigenvalue of |
c | the conjugate pair by taking |
c | the conjugate of the last |
c | eigenvalue computed. |
c %------------------------------%
c
d(j,1) = d(j-1,1)
d(j,2) = -d(j-1,2)
first = .true.
c
end if
c
70 continue
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
first = .true.
nconv = iparam(5)
do 80 j=1, nconv
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j+1), mx)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV6 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv6. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n), w(n), one, four
parameter (one = 1.0E+0, four = 4.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)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), three, two
parameter (three = 3.0E+0, two = 2.0E+0)
c
c Compute the matrix vector multiplication y<---A*x
c where M is a n by n symmetric tridiagonal matrix with 2 on the
c diagonal, -2 on the subdiagonal and 3 on the superdiagonal.
c
w(1) = two*v(1) + three*v(2)
do 10 j = 2,n-1
w(j) = -two*v(j-1) + two*v(j) + three*v(j+1)
10 continue
w(n) = -two*v(n-1) + two*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv1.f 0000644 0001750 0001750 00000040375 12277373057 014140 0000000 0000000 program dndrv1
c
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square [0,1]x[0,1] with zero Dirichlet boundary
c condition.
c
c ... OP = A and B = I.
c
c ... Assume "call av (nx,x,y)" computes y = A*x.c
c
c ... Use mode 1 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of DNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(nx, v(1,j), ax)
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
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(nx, v(1,j), ax)
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 av(nx, v(1,j+1), ax)
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
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV1 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv1. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Double precision
& v(nx*nx), w(nx*nx), one, h2
parameter (one = 1.0D+0)
external daxpy
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c
h2 = one / dble((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call daxpy(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 daxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(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 daxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), h, h2, dd, dl, du
c
Double precision
& one, zero, rho
parameter (one = 1.0D+0, zero = 0.0D+0,
& rho = 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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / dble(nx+1)
h2 = h*h
dd = 4.0D+0 / h2
dl = -one / h2 - 5.0D-1*rho / h
du = -one / h2 + 5.0D-1*rho / h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv3.f 0000644 0001750 0001750 00000041356 12277373057 014142 0000000 0000000 program dndrv3
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A and B are derived from the finite element discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition
c using linear elements.
c
c ... So OP = inv[M]*A and B = M.
c
c ... Use mode 2 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dpttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c dpttrs LAPACK symmetric positive definite tridiagonal solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Double precision
& tol, sigmar, sigmai, h
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one
parameter (zero = 0.0D+0, one = 1.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Double precision
& dnrm2, dlapy2
external daxpy, dnrm2, dpttrf, dpttrs, dlapy2
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %------------------------------------------------%
c | M is the mass matrix formed by using piecewise |
c | linear elements on [0,1]. |
c %------------------------------------------------%
c
h = one / dble(n+1)
do 20 j = 1, n-1
md(j) = 4.0D+0*h
me(j) = one*h
20 continue
md(n) = 4.0D+0*h
c
call dpttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 DNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call dpttrs(n, 1, md, me, workd(ipntr(2)), n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
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,3) = dnrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
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)
call mv(n, v(1,j+1), mx)
call daxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = dnrm2(n, ax, 1)**2
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call daxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
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
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV3 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv3. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, dd, dl, du, s, h, rho
parameter ( rho = 1.0D+1, one = 1.0D+0,
& two = 2.0D+0)
c
c Compute the matrix vector multiplication y<---A*x
c where A is stiffness matrix obtained from the finite element
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 Dirichlet boundary condition using
c linear elements.
c
h = one / dble(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
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)
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear
c elements on [0,1].
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
c
h = one / dble(n+1)
call dscal(n, h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/README 0000644 0001750 0001750 00000004217 12277373057 013446 0000000 0000000 1. Purpose
-------
This directory contains example drivers that call ARPACK subroutines
[s,d]naupd.f and [s,d]neupd.f to solve real NONSYMMETRIC eigenvalue
problems using regular, inverse or shift-invert modes. These drivers
illustrate how to set various ARPACK parameters to solve different
problems in different modes. They provide a guideline on how to use
ARPACK's reverse communication interface. The user may modify any one
of these drivers, and provide his/her own matrix vector multiplication
routine to solve the problem of his/her own interest.
2. Naming convention
-----------------
The name for each driver has the form 'XndrvN.f', where
X - is 's' (single precision)
or 'd' (double precision)
N - is a number between 1 and 6. If
N = 1, the driver solves a STANDARD eigenvalue problem in
REGULAR mode.
N = 2, the driver solves a STANDARD eigenvalue problem in
SHIFT-INVERT mode with a REAL shift.
N = 3, the driver solves a GENERALIZED eigenvalue problem in
INVERSE mode.
N = 4, the driver solves a GENERALIZED eigenvalue problem in
SHIFT-INVERT mode with a REAL shift.
These are 4 commonly used drivers. For shift-invert (N=2,4) mode
the user needs to supply a linear system solver to perform
y=inv[A-sigma*B]*x.
If N > 4, shift-invert is used with a complex shift whose imaginary
part is nonzero. If
N = 5, the driver solves a GENERALIZED eigenvalue problem
using mode 3 of [s,d]naupd.
N = 6. the driver solves a GENERALIZED eigenvalue problem
using mode 4 of [s,d]naupd.
These two drivers require the user to provide COMPLEX arithmetic
linear system solver. For more information on the use of
complex shift, see the following reference:
B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
Real Matrices", Linear Algebra and its Applications, vol 88/89,
pp 575-595, (1987).
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make sndrv1". Then
execute using "sndrv1".
arpack-ng-3.1.5/EXAMPLES/NONSYM/Makefile.am 0000644 0001750 0001750 00000002355 12277670164 014622 0000000 0000000 check_PROGRAMS = dndrv1 dndrv2 dndrv3 dndrv4 dndrv5 dndrv6 sndrv1 sndrv2 sndrv3 sndrv4 sndrv5 sndrv6
dndrv1_SOURCES = dndrv1.f
dndrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv2_SOURCES = dndrv2.f
dndrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv3_SOURCES = dndrv3.f
dndrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv4_SOURCES = dndrv4.f
dndrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv5_SOURCES = dndrv5.f
dndrv5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv6_SOURCES = dndrv6.f
dndrv6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv1_SOURCES = sndrv1.f
sndrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv2_SOURCES = sndrv2.f
sndrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv3_SOURCES = sndrv3.f
sndrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv4_SOURCES = sndrv4.f
sndrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv5_SOURCES = sndrv5.f
sndrv5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv6_SOURCES = sndrv6.f
sndrv6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = dndrv1 dndrv2 dndrv3 dndrv4 dndrv5 dndrv6 sndrv1 sndrv2 sndrv3 sndrv4 sndrv5 sndrv6
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv6.f 0000644 0001750 0001750 00000053501 12277373057 014140 0000000 0000000 program dndrv6
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example six of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-6
c
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode
c The matrix A is the tridiagonal matrix with 2 on the diagonal,
c -2 on the subdiagonal and 3 on the superdiagonal. The matrix M
c is the tridiagonal matrix with 4 on the diagonal and 1 on the
c off-diagonals.
c ... The shift sigma is a complex number (sigmar, sigmai).
c ... OP = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M and B = M.
c ... Use mode 4 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c zgttrf LAPACK complex matrix factorization routine.
c zgttrs LAPACK complex linear system solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c ddot Level 1 BLAS that computes the dot product of two vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector subroutine that computes A*x.
c mv Matrix vector subroutine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
Complex*16
& cdd(maxn), cdl(maxn), cdu(maxn),
& cdu2(maxn), ctemp(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Double precision
& tol, numr, numi, denr, deni, sigmar, sigmai
Complex*16
& c1, c2, c3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
external zgttrf, zgttrs
Double precision
& ddot, dnrm2, dlapy2
external ddot, dnrm2, dlapy2
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %--------------------%
c | Intrinsic Function |
c %--------------------%
c
intrinsic dimag, dcmplx, abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to the shift (SIGMAR,SIGMAI)) to be approximated. |
c | Since the shift-invert mode is used, WHICH is set |
c | to 'LM'. The user can modify NEV, NCV, SIGMA to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0D-1
sigmai = 6.0D-1
c
c %----------------------------------------------------%
c | Construct C = A - (SIGMAR,SIGMAI)*M in complex |
c | arithmetic, and factor C in complex arithmetic |
c | (using LAPACK subroutine zgttrf). The matrix A is |
c | chosen to be the tridiagonal matrix with -2 on the |
c | subdiagonal, 2 on the diagonal and 3 on the |
c | superdiagonal. The matrix M is chosen to be the |
c | symmetric tridiagonal matrix with 4 on the |
c | diagonal and 1 on the off-diagonals. |
c %----------------------------------------------------%
c
c1 = dcmplx(-2.0D+0-sigmar, -sigmai)
c2 = dcmplx( 2.0D+0-4.0D+0*sigmar, -4.0D+0*sigmai)
c3 = dcmplx( 3.0D+0-sigmar, -sigmai)
c
do 10 j = 1, n-1
cdl(j) = c1
cdd(j) = c2
cdu(j) = c3
10 continue
cdd(n) = c2
c
call zgttrf(n, cdl, cdd, cdu, cdu2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV6.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 3 of DNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %------------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | to force starting vector into the range of OP. The user |
c | should supply his/her own matrix vector multiplication |
c | routine and a complex linear system solver. The matrix |
c | vector multiplication routine should take workd(ipntr(1)) |
c | as the input. The final result (a real vector) should be |
c | returned to workd(ipntr(2)). |
c %------------------------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
do 30 j = 1, n
ctemp(j) = dcmplx(workd(ipntr(2)+j-1))
30 continue
c
call zgttrs('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, maxn, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV6.'
print*, ' '
go to 9000
end if
do 40 j = 1, n
workd(ipntr(2)+j-1) = dimag(ctemp(j))
40 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %------------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Imaginary_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | M*x has been saved in workd(ipntr(3)). The user only need |
c | the complex linear system solver here that takes |
c | complex[workd(ipntr(3))] as input, and returns the result |
c | to workd(ipntr(2)). |
c %------------------------------------------------------------%
c
do 50 j = 1,n
ctemp(j) = dcmplx(workd(ipntr(3)+j-1))
50 continue
call zgttrs ('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, maxn, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV6.'
print*, ' '
go to 9000
end if
do 60 j = 1, n
workd(ipntr(2)+j-1) = dimag(ctemp(j))
60 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 70 j=1, nconv
c
c %-------------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original problem.|
c %-------------------------------------%
c
if ( d(j,2) .eq. zero) then
c
c %----------------------------%
c | Eigenvalue is real. |
c | Compute d = x'(Ax)/x'(Mx). |
c %----------------------------%
c
call av(n, v(1,j), ax )
numr = ddot(n, v(1,j), 1, ax, 1)
call mv(n, v(1,j), ax )
denr = ddot(n, v(1,j), 1, ax, 1)
d(j,1) = numr / denr
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %----------------%
c | Compute x'(Ax) |
c %----------------%
c
call av(n, v(1,j), ax )
numr = ddot(n, v(1,j), 1, ax, 1)
numi = ddot(n, v(1,j+1), 1, ax, 1)
call av(n, v(1,j+1), ax)
numr = numr + ddot(n,v(1,j+1),1,ax,1)
numi = -numi + ddot(n,v(1,j),1,ax,1)
c
c %----------------%
c | Compute x'(Mx) |
c %----------------%
c
call mv(n, v(1,j), ax )
denr = ddot(n, v(1,j), 1, ax, 1)
deni = ddot(n, v(1,j+1), 1, ax, 1)
call mv(n, v(1,j+1), ax)
denr = denr + ddot(n,v(1,j+1),1,ax,1)
deni = -deni + ddot(n,v(1,j),1, ax,1)
c
c %----------------%
c | d=x'(Ax)/x'(Mx)|
c %----------------%
c
d(j,1) = (numr*denr+numi*deni) /
& dlapy2(denr, deni)
d(j,2) = (numi*denr-numr*deni) /
& dlapy2(denr, deni)
first = .false.
c
else
c
c %------------------------------%
c | Get the second eigenvalue of |
c | the conjugate pair by taking |
c | the conjugate of the last |
c | eigenvalue computed. |
c %------------------------------%
c
d(j,1) = d(j-1,1)
d(j,2) = -d(j-1,2)
first = .true.
c
end if
c
70 continue
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
first = .true.
nconv = iparam(5)
do 80 j=1, nconv
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
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,3) = dnrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
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)
call mv(n, v(1,j+1), mx)
call daxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = dnrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call daxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
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
first = .true.
end if
c
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV6 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv6. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, four
parameter (one = 1.0D+0, four = 4.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)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), three, two
parameter (three = 3.0D+0, two = 2.0D+0)
c
c Compute the matrix vector multiplication y<---A*x
c where M is a n by n symmetric tridiagonal matrix with 2 on the
c diagonal, -2 on the subdiagonal and 3 on the superdiagonal.
c
w(1) = two*v(1) + three*v(2)
do 10 j = 2,n-1
w(j) = -two*v(j-1) + two*v(j) + three*v(j+1)
10 continue
w(n) = -two*v(n-1) + two*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/Makefile 0000644 0001750 0001750 00000114722 12277671461 014231 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/NONSYM/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = dndrv1$(EXEEXT) dndrv2$(EXEEXT) dndrv3$(EXEEXT) \
dndrv4$(EXEEXT) dndrv5$(EXEEXT) dndrv6$(EXEEXT) \
sndrv1$(EXEEXT) sndrv2$(EXEEXT) sndrv3$(EXEEXT) \
sndrv4$(EXEEXT) sndrv5$(EXEEXT) sndrv6$(EXEEXT)
TESTS = dndrv1$(EXEEXT) dndrv2$(EXEEXT) dndrv3$(EXEEXT) \
dndrv4$(EXEEXT) dndrv5$(EXEEXT) dndrv6$(EXEEXT) \
sndrv1$(EXEEXT) sndrv2$(EXEEXT) sndrv3$(EXEEXT) \
sndrv4$(EXEEXT) sndrv5$(EXEEXT) sndrv6$(EXEEXT)
subdir = EXAMPLES/NONSYM
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dndrv1_OBJECTS = dndrv1.$(OBJEXT)
dndrv1_OBJECTS = $(am_dndrv1_OBJECTS)
am__DEPENDENCIES_1 =
dndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_dndrv2_OBJECTS = dndrv2.$(OBJEXT)
dndrv2_OBJECTS = $(am_dndrv2_OBJECTS)
dndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv3_OBJECTS = dndrv3.$(OBJEXT)
dndrv3_OBJECTS = $(am_dndrv3_OBJECTS)
dndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv4_OBJECTS = dndrv4.$(OBJEXT)
dndrv4_OBJECTS = $(am_dndrv4_OBJECTS)
dndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv5_OBJECTS = dndrv5.$(OBJEXT)
dndrv5_OBJECTS = $(am_dndrv5_OBJECTS)
dndrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv6_OBJECTS = dndrv6.$(OBJEXT)
dndrv6_OBJECTS = $(am_dndrv6_OBJECTS)
dndrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv1_OBJECTS = sndrv1.$(OBJEXT)
sndrv1_OBJECTS = $(am_sndrv1_OBJECTS)
sndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv2_OBJECTS = sndrv2.$(OBJEXT)
sndrv2_OBJECTS = $(am_sndrv2_OBJECTS)
sndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv3_OBJECTS = sndrv3.$(OBJEXT)
sndrv3_OBJECTS = $(am_sndrv3_OBJECTS)
sndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv4_OBJECTS = sndrv4.$(OBJEXT)
sndrv4_OBJECTS = $(am_sndrv4_OBJECTS)
sndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv5_OBJECTS = sndrv5.$(OBJEXT)
sndrv5_OBJECTS = $(am_sndrv5_OBJECTS)
sndrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv6_OBJECTS = sndrv6.$(OBJEXT)
sndrv6_OBJECTS = $(am_sndrv6_OBJECTS)
sndrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dndrv1_SOURCES) $(dndrv2_SOURCES) $(dndrv3_SOURCES) \
$(dndrv4_SOURCES) $(dndrv5_SOURCES) $(dndrv6_SOURCES) \
$(sndrv1_SOURCES) $(sndrv2_SOURCES) $(sndrv3_SOURCES) \
$(sndrv4_SOURCES) $(sndrv5_SOURCES) $(sndrv6_SOURCES)
DIST_SOURCES = $(dndrv1_SOURCES) $(dndrv2_SOURCES) $(dndrv3_SOURCES) \
$(dndrv4_SOURCES) $(dndrv5_SOURCES) $(dndrv6_SOURCES) \
$(sndrv1_SOURCES) $(sndrv2_SOURCES) $(sndrv3_SOURCES) \
$(sndrv4_SOURCES) $(sndrv5_SOURCES) $(sndrv6_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/NONSYM
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/NONSYM
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
dndrv1_SOURCES = dndrv1.f
dndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv2_SOURCES = dndrv2.f
dndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv3_SOURCES = dndrv3.f
dndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv4_SOURCES = dndrv4.f
dndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv5_SOURCES = dndrv5.f
dndrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv6_SOURCES = dndrv6.f
dndrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv1_SOURCES = sndrv1.f
sndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv2_SOURCES = sndrv2.f
sndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv3_SOURCES = sndrv3.f
sndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv4_SOURCES = sndrv4.f
sndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv5_SOURCES = sndrv5.f
sndrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv6_SOURCES = sndrv6.f
sndrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/NONSYM/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/NONSYM/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dndrv1$(EXEEXT): $(dndrv1_OBJECTS) $(dndrv1_DEPENDENCIES) $(EXTRA_dndrv1_DEPENDENCIES)
@rm -f dndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv1_OBJECTS) $(dndrv1_LDADD) $(LIBS)
dndrv2$(EXEEXT): $(dndrv2_OBJECTS) $(dndrv2_DEPENDENCIES) $(EXTRA_dndrv2_DEPENDENCIES)
@rm -f dndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv2_OBJECTS) $(dndrv2_LDADD) $(LIBS)
dndrv3$(EXEEXT): $(dndrv3_OBJECTS) $(dndrv3_DEPENDENCIES) $(EXTRA_dndrv3_DEPENDENCIES)
@rm -f dndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv3_OBJECTS) $(dndrv3_LDADD) $(LIBS)
dndrv4$(EXEEXT): $(dndrv4_OBJECTS) $(dndrv4_DEPENDENCIES) $(EXTRA_dndrv4_DEPENDENCIES)
@rm -f dndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv4_OBJECTS) $(dndrv4_LDADD) $(LIBS)
dndrv5$(EXEEXT): $(dndrv5_OBJECTS) $(dndrv5_DEPENDENCIES) $(EXTRA_dndrv5_DEPENDENCIES)
@rm -f dndrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv5_OBJECTS) $(dndrv5_LDADD) $(LIBS)
dndrv6$(EXEEXT): $(dndrv6_OBJECTS) $(dndrv6_DEPENDENCIES) $(EXTRA_dndrv6_DEPENDENCIES)
@rm -f dndrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv6_OBJECTS) $(dndrv6_LDADD) $(LIBS)
sndrv1$(EXEEXT): $(sndrv1_OBJECTS) $(sndrv1_DEPENDENCIES) $(EXTRA_sndrv1_DEPENDENCIES)
@rm -f sndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv1_OBJECTS) $(sndrv1_LDADD) $(LIBS)
sndrv2$(EXEEXT): $(sndrv2_OBJECTS) $(sndrv2_DEPENDENCIES) $(EXTRA_sndrv2_DEPENDENCIES)
@rm -f sndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv2_OBJECTS) $(sndrv2_LDADD) $(LIBS)
sndrv3$(EXEEXT): $(sndrv3_OBJECTS) $(sndrv3_DEPENDENCIES) $(EXTRA_sndrv3_DEPENDENCIES)
@rm -f sndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv3_OBJECTS) $(sndrv3_LDADD) $(LIBS)
sndrv4$(EXEEXT): $(sndrv4_OBJECTS) $(sndrv4_DEPENDENCIES) $(EXTRA_sndrv4_DEPENDENCIES)
@rm -f sndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv4_OBJECTS) $(sndrv4_LDADD) $(LIBS)
sndrv5$(EXEEXT): $(sndrv5_OBJECTS) $(sndrv5_DEPENDENCIES) $(EXTRA_sndrv5_DEPENDENCIES)
@rm -f sndrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv5_OBJECTS) $(sndrv5_LDADD) $(LIBS)
sndrv6$(EXEEXT): $(sndrv6_OBJECTS) $(sndrv6_DEPENDENCIES) $(EXTRA_sndrv6_DEPENDENCIES)
@rm -f sndrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv6_OBJECTS) $(sndrv6_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dndrv1.log: dndrv1$(EXEEXT)
@p='dndrv1$(EXEEXT)'; \
b='dndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv2.log: dndrv2$(EXEEXT)
@p='dndrv2$(EXEEXT)'; \
b='dndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv3.log: dndrv3$(EXEEXT)
@p='dndrv3$(EXEEXT)'; \
b='dndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv4.log: dndrv4$(EXEEXT)
@p='dndrv4$(EXEEXT)'; \
b='dndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv5.log: dndrv5$(EXEEXT)
@p='dndrv5$(EXEEXT)'; \
b='dndrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv6.log: dndrv6$(EXEEXT)
@p='dndrv6$(EXEEXT)'; \
b='dndrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv1.log: sndrv1$(EXEEXT)
@p='sndrv1$(EXEEXT)'; \
b='sndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv2.log: sndrv2$(EXEEXT)
@p='sndrv2$(EXEEXT)'; \
b='sndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv3.log: sndrv3$(EXEEXT)
@p='sndrv3$(EXEEXT)'; \
b='sndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv4.log: sndrv4$(EXEEXT)
@p='sndrv4$(EXEEXT)'; \
b='sndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv5.log: sndrv5$(EXEEXT)
@p='sndrv5$(EXEEXT)'; \
b='sndrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv6.log: sndrv6$(EXEEXT)
@p='sndrv6$(EXEEXT)'; \
b='sndrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/NONSYM/Makefile.in 0000644 0001750 0001750 00000113052 12277670174 014631 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = dndrv1$(EXEEXT) dndrv2$(EXEEXT) dndrv3$(EXEEXT) \
dndrv4$(EXEEXT) dndrv5$(EXEEXT) dndrv6$(EXEEXT) \
sndrv1$(EXEEXT) sndrv2$(EXEEXT) sndrv3$(EXEEXT) \
sndrv4$(EXEEXT) sndrv5$(EXEEXT) sndrv6$(EXEEXT)
TESTS = dndrv1$(EXEEXT) dndrv2$(EXEEXT) dndrv3$(EXEEXT) \
dndrv4$(EXEEXT) dndrv5$(EXEEXT) dndrv6$(EXEEXT) \
sndrv1$(EXEEXT) sndrv2$(EXEEXT) sndrv3$(EXEEXT) \
sndrv4$(EXEEXT) sndrv5$(EXEEXT) sndrv6$(EXEEXT)
subdir = EXAMPLES/NONSYM
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dndrv1_OBJECTS = dndrv1.$(OBJEXT)
dndrv1_OBJECTS = $(am_dndrv1_OBJECTS)
am__DEPENDENCIES_1 =
dndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_dndrv2_OBJECTS = dndrv2.$(OBJEXT)
dndrv2_OBJECTS = $(am_dndrv2_OBJECTS)
dndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv3_OBJECTS = dndrv3.$(OBJEXT)
dndrv3_OBJECTS = $(am_dndrv3_OBJECTS)
dndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv4_OBJECTS = dndrv4.$(OBJEXT)
dndrv4_OBJECTS = $(am_dndrv4_OBJECTS)
dndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv5_OBJECTS = dndrv5.$(OBJEXT)
dndrv5_OBJECTS = $(am_dndrv5_OBJECTS)
dndrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dndrv6_OBJECTS = dndrv6.$(OBJEXT)
dndrv6_OBJECTS = $(am_dndrv6_OBJECTS)
dndrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv1_OBJECTS = sndrv1.$(OBJEXT)
sndrv1_OBJECTS = $(am_sndrv1_OBJECTS)
sndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv2_OBJECTS = sndrv2.$(OBJEXT)
sndrv2_OBJECTS = $(am_sndrv2_OBJECTS)
sndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv3_OBJECTS = sndrv3.$(OBJEXT)
sndrv3_OBJECTS = $(am_sndrv3_OBJECTS)
sndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv4_OBJECTS = sndrv4.$(OBJEXT)
sndrv4_OBJECTS = $(am_sndrv4_OBJECTS)
sndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv5_OBJECTS = sndrv5.$(OBJEXT)
sndrv5_OBJECTS = $(am_sndrv5_OBJECTS)
sndrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sndrv6_OBJECTS = sndrv6.$(OBJEXT)
sndrv6_OBJECTS = $(am_sndrv6_OBJECTS)
sndrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dndrv1_SOURCES) $(dndrv2_SOURCES) $(dndrv3_SOURCES) \
$(dndrv4_SOURCES) $(dndrv5_SOURCES) $(dndrv6_SOURCES) \
$(sndrv1_SOURCES) $(sndrv2_SOURCES) $(sndrv3_SOURCES) \
$(sndrv4_SOURCES) $(sndrv5_SOURCES) $(sndrv6_SOURCES)
DIST_SOURCES = $(dndrv1_SOURCES) $(dndrv2_SOURCES) $(dndrv3_SOURCES) \
$(dndrv4_SOURCES) $(dndrv5_SOURCES) $(dndrv6_SOURCES) \
$(sndrv1_SOURCES) $(sndrv2_SOURCES) $(sndrv3_SOURCES) \
$(sndrv4_SOURCES) $(sndrv5_SOURCES) $(sndrv6_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
dndrv1_SOURCES = dndrv1.f
dndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv2_SOURCES = dndrv2.f
dndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv3_SOURCES = dndrv3.f
dndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv4_SOURCES = dndrv4.f
dndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv5_SOURCES = dndrv5.f
dndrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dndrv6_SOURCES = dndrv6.f
dndrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv1_SOURCES = sndrv1.f
sndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv2_SOURCES = sndrv2.f
sndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv3_SOURCES = sndrv3.f
sndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv4_SOURCES = sndrv4.f
sndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv5_SOURCES = sndrv5.f
sndrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sndrv6_SOURCES = sndrv6.f
sndrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/NONSYM/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/NONSYM/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dndrv1$(EXEEXT): $(dndrv1_OBJECTS) $(dndrv1_DEPENDENCIES) $(EXTRA_dndrv1_DEPENDENCIES)
@rm -f dndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv1_OBJECTS) $(dndrv1_LDADD) $(LIBS)
dndrv2$(EXEEXT): $(dndrv2_OBJECTS) $(dndrv2_DEPENDENCIES) $(EXTRA_dndrv2_DEPENDENCIES)
@rm -f dndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv2_OBJECTS) $(dndrv2_LDADD) $(LIBS)
dndrv3$(EXEEXT): $(dndrv3_OBJECTS) $(dndrv3_DEPENDENCIES) $(EXTRA_dndrv3_DEPENDENCIES)
@rm -f dndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv3_OBJECTS) $(dndrv3_LDADD) $(LIBS)
dndrv4$(EXEEXT): $(dndrv4_OBJECTS) $(dndrv4_DEPENDENCIES) $(EXTRA_dndrv4_DEPENDENCIES)
@rm -f dndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv4_OBJECTS) $(dndrv4_LDADD) $(LIBS)
dndrv5$(EXEEXT): $(dndrv5_OBJECTS) $(dndrv5_DEPENDENCIES) $(EXTRA_dndrv5_DEPENDENCIES)
@rm -f dndrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv5_OBJECTS) $(dndrv5_LDADD) $(LIBS)
dndrv6$(EXEEXT): $(dndrv6_OBJECTS) $(dndrv6_DEPENDENCIES) $(EXTRA_dndrv6_DEPENDENCIES)
@rm -f dndrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dndrv6_OBJECTS) $(dndrv6_LDADD) $(LIBS)
sndrv1$(EXEEXT): $(sndrv1_OBJECTS) $(sndrv1_DEPENDENCIES) $(EXTRA_sndrv1_DEPENDENCIES)
@rm -f sndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv1_OBJECTS) $(sndrv1_LDADD) $(LIBS)
sndrv2$(EXEEXT): $(sndrv2_OBJECTS) $(sndrv2_DEPENDENCIES) $(EXTRA_sndrv2_DEPENDENCIES)
@rm -f sndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv2_OBJECTS) $(sndrv2_LDADD) $(LIBS)
sndrv3$(EXEEXT): $(sndrv3_OBJECTS) $(sndrv3_DEPENDENCIES) $(EXTRA_sndrv3_DEPENDENCIES)
@rm -f sndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv3_OBJECTS) $(sndrv3_LDADD) $(LIBS)
sndrv4$(EXEEXT): $(sndrv4_OBJECTS) $(sndrv4_DEPENDENCIES) $(EXTRA_sndrv4_DEPENDENCIES)
@rm -f sndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv4_OBJECTS) $(sndrv4_LDADD) $(LIBS)
sndrv5$(EXEEXT): $(sndrv5_OBJECTS) $(sndrv5_DEPENDENCIES) $(EXTRA_sndrv5_DEPENDENCIES)
@rm -f sndrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv5_OBJECTS) $(sndrv5_LDADD) $(LIBS)
sndrv6$(EXEEXT): $(sndrv6_OBJECTS) $(sndrv6_DEPENDENCIES) $(EXTRA_sndrv6_DEPENDENCIES)
@rm -f sndrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sndrv6_OBJECTS) $(sndrv6_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dndrv1.log: dndrv1$(EXEEXT)
@p='dndrv1$(EXEEXT)'; \
b='dndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv2.log: dndrv2$(EXEEXT)
@p='dndrv2$(EXEEXT)'; \
b='dndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv3.log: dndrv3$(EXEEXT)
@p='dndrv3$(EXEEXT)'; \
b='dndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv4.log: dndrv4$(EXEEXT)
@p='dndrv4$(EXEEXT)'; \
b='dndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv5.log: dndrv5$(EXEEXT)
@p='dndrv5$(EXEEXT)'; \
b='dndrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dndrv6.log: dndrv6$(EXEEXT)
@p='dndrv6$(EXEEXT)'; \
b='dndrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv1.log: sndrv1$(EXEEXT)
@p='sndrv1$(EXEEXT)'; \
b='sndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv2.log: sndrv2$(EXEEXT)
@p='sndrv2$(EXEEXT)'; \
b='sndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv3.log: sndrv3$(EXEEXT)
@p='sndrv3$(EXEEXT)'; \
b='sndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv4.log: sndrv4$(EXEEXT)
@p='sndrv4$(EXEEXT)'; \
b='sndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv5.log: sndrv5$(EXEEXT)
@p='sndrv5$(EXEEXT)'; \
b='sndrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sndrv6.log: sndrv6$(EXEEXT)
@p='sndrv6$(EXEEXT)'; \
b='sndrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv1.f 0000644 0001750 0001750 00000040251 12277373057 014150 0000000 0000000 program sndrv1
c
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square [0,1]x[0,1] with zero Dirichlet boundary
c condition.
c
c ... OP = A and B = I.
c
c ... Assume "call av (nx,x,y)" computes y = A*x.c
c
c ... Use mode 1 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of SNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(nx, v(1,j+1), ax)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV1 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv1. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Real
& v(nx*nx), w(nx*nx), one, h2
parameter (one = 1.0E+0)
external saxpy
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c
h2 = one / real((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call saxpy(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 saxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(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 saxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), h, h2, dd, dl, du
c
Real
& one, zero, rho
parameter (one = 1.0E+0, zero = 0.0E+0,
& rho = 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
c diagonal, DL on the subdiagonal, and DU on the superdiagonal.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / real(nx+1)
h2 = h*h
dd = 4.0E+0 / h2
dl = -one / h2 - 5.0E-1*rho / h
du = -one / h2 + 5.0E-1*rho / h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/dndrv2.f 0000644 0001750 0001750 00000037561 12277373057 014144 0000000 0000000 program dndrv2
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a standard nonsymmetric eigenvalue problem.
c
c We implement example two of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the centered difference discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u / dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition.
c
c ... The shift sigma is a real number.
c
c ... OP = inv[A-sigma*I] and B = I.
c
c ... Use mode 3 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dgttrf LAPACK tridiagonal factorization routine.
c dgttrs LAPACK tridiagonal solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dcopy Level 1 BLAS that copies one vector to another.
c ddot Level 1 BLAS that computes the dot product of two vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Double precision
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv, maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& dd(maxn), dl(maxn), du(maxn),
& du2(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Double precision
& tol, h, s,
& sigmar, sigmai, s1, s2, s3
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two, rho
common /convct/ rho
parameter (one = 1.0D+0, zero = 0.0D+0,
& two = 2.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& ddot, dnrm2, dlapy2
external dgttrf, dgttrs, ddot, dnrm2, dlapy2
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = |
c | 'I'). NEV is the number of eigenvalues (closest |
c | to the shift SIGMAR) to be approximated. Since |
c | the shift-invert mode is used, WHICH is set to |
c | 'LM'. The user can modify NEV, NCV, SIGMAR to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 1.0D+0
sigmai = 0.0D+0
c
c %----------------------------------------------------%
c | Construct C = A - SIGMA*I in real arithmetic, and |
c | factor C in real arithmetic using LAPACK |
c | subroutine dgttrf. The matrix A is chosen to be |
c | the tridiagonal matrix derived from standard |
c | central difference of the 1-d convection diffusion |
c | operator u" + rho*u' on the interval [0, 1] with |
c | zero Dirichlet boundary condition. |
c %----------------------------------------------------%
c
rho = 1.0D+1
h = one / dble(n+1)
s = rho*h / two
c
s1 = -one-s
s2 = two - sigmar
s3 = -one+s
c
do 10 j = 1, n-1
dl(j) = s1
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call dgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 DNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if ( ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*I]*x |
c | The user should supply his/her own linear |
c | system solver here that takes |
c | workd(ipntr(1)) as the input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------%
c
call dcopy( n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
c
call dgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
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
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
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 av(n, v(1,j+1), ax)
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+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV2 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dndrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c-------------------------------------------------------------------
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), rho, two, one, dd, dl, du, s, h
common /convct/ rho
parameter (one = 1.0D+0, two = 2.0D+0 )
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived from
c the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
c
h = one / dble(n+1)
s = rho *h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/NONSYM/sndrv5.f 0000644 0001750 0001750 00000053161 12277373057 014160 0000000 0000000 program sndrv5
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example five of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-5
c
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode
c The matrix A is the tridiagonal matrix with 2 on the diagonal,
c -2 on the subdiagonal and 3 on the superdiagonal. The matrix M
c is the tridiagonal matrix with 4 on the diagonal and 1 on the
c off-diagonals.
c ... The shift sigma is a complex number (sigmar, sigmai).
c ... OP = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M and B = M.
c ... Use mode 3 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgttrf LAPACK complex matrix factorization routine.
c cgttrs LAPACK complex linear system solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector
c av Matrix vector subroutine that computes A*x.
c mv Matrix vector subroutine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
Complex
& cdd(maxn), cdl(maxn), cdu(maxn),
& cdu2(maxn), ctemp(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Real
& tol, numr, numi, denr, deni, sigmar, sigmai
Complex
& c1, c2, c3
logical first, rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
external cgttrf, cgttrs
Real
& sdot, snrm2, slapy2
external sdot, snrm2, slapy2
c
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %--------------------%
c | Intrinsic Function |
c %--------------------%
c
intrinsic real, cmplx, abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to the shift (SIGMAR,SIGMAI)) to be approximated. |
c | Since the shift-invert mode is used, WHICH is set |
c | to 'LM'. The user can modify NEV, NCV, SIGMAR, |
c | SIGMAI to solve problems of different sizes, and |
c | to get different parts of the spectrum. However, |
c | The following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0E-1
sigmai = 6.0E-1
c
c %---------------------------------------------------%
c | Construct C = A - (SIGMAR,SIGMAI)*M in complex |
c | arithmetic, and factor C in complex arithmetic |
c | (using LAPACK subroutine cgttrf). The matrix A is |
c | chosen to be the tridiagonal matrix with -2 on |
c | the subdiagonal, 2 on the diagonal and 3 on the |
c | superdiagonal. The matrix M is chosen to the |
c | symmetric tridiagonal matrix with 4 on the |
c | diagonal and 1 on the off-diagonals. |
c %---------------------------------------------------%
c
c1 = cmplx(-2.0E+0-sigmar, -sigmai)
c2 = cmplx( 2.0E+0-4.0E+0*sigmar, -4.0E+0*sigmai)
c3 = cmplx( 3.0E+0-sigmar, -sigmai)
c
do 10 j = 1, n-1
cdl(j) = c1
cdd(j) = c2
cdu(j) = c3
10 continue
cdd(n) = c2
c
call cgttrf(n, cdl, cdd, cdu, cdu2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV5.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 3 of SNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | to force starting vector into the range of OP. The |
c | user should supply his/her own matrix vector |
c | multiplication routine and a complex linear system |
c | solver. The matrix vector multiplication routine |
c | should take workd(ipntr(1)) as the input. The final |
c | result (a real vector) should be returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
do 30 j = 1, n
ctemp(j) = cmplx(workd(ipntr(2)+j-1))
30 continue
c
call cgttrs('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV5.'
print*, ' '
go to 9000
end if
do 40 j = 1, n
workd(ipntr(2)+j-1) = real(ctemp(j))
40 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-------------------------------------------------------%
c | Perform |
c | y <--- OP*x = Real_Part{inv[A-(SIGMAR,SIGMAI)*M]*M*x} |
c | M*x has been saved in workd(ipntr(3)). The user only |
c | needs the complex linear system solver here that |
c | takes complex[workd(ipntr(3))] as input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------------------%
c
do 50 j = 1,n
ctemp(j) = cmplx(workd(ipntr(3)+j-1))
50 continue
call cgttrs ('N', n, 1, cdl, cdd, cdu, cdu2, ipiv,
& ctemp, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV5.'
print*, ' '
go to 9000
end if
do 60 j = 1, n
workd(ipntr(2)+j-1) = real(ctemp(j))
60 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c
c %------------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %------------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 70 j=1,nconv
c
c %-------------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original problem.|
c %-------------------------------------%
c
if ( d(j,2) .eq. zero ) then
c
c %---------------------------%
c | Eigenvalue is real. |
c | Compute d = x'(Ax)/x'(Mx).|
c %---------------------------%
c
call av(n, v(1,j), ax )
numr = sdot(n, v(1,j), 1, ax, 1)
call mv(n, v(1,j), ax )
denr = sdot(n, v(1,j), 1, ax, 1)
d(j,1) = numr / denr
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %----------------%
c | Compute x'(Ax) |
c %----------------%
call av(n, v(1,j), ax )
numr = sdot(n, v(1,j), 1, ax, 1)
numi = sdot(n, v(1,j+1), 1, ax, 1)
call av(n, v(1,j+1), ax)
numr = numr + sdot(n,v(1,j+1),1,ax,1)
numi = -numi + sdot(n,v(1,j),1,ax,1)
c
c %----------------%
c | Compute x'(Mx) |
c %----------------%
c
call mv(n, v(1,j), ax )
denr = sdot(n, v(1,j), 1, ax, 1)
deni = sdot(n, v(1,j+1), 1, ax, 1)
call mv(n, v(1,j+1), ax)
denr = denr + sdot(n,v(1,j+1),1,ax,1)
deni = -deni + sdot(n,v(1,j),1, ax,1)
c
c %----------------%
c | d=x'(Ax)/x'(Mx)|
c %----------------%
c
d(j,1) = (numr*denr+numi*deni) /
& slapy2(denr, deni)
d(j,2) = (numi*denr-numr*deni) /
& slapy2(denr, deni)
first = .false.
c
else
c
c %------------------------------%
c | Get the second eigenvalue of |
c | the conjugate pair by taking |
c | the conjugate of the last |
c | eigenvalue computed. |
c %------------------------------%
c
d(j,1) = d(j-1,1)
d(j,2) = -d(j-1,2)
first = .true.
c
end if
c
70 continue
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
first = .true.
do 80 j=1, nconv
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j+1), mx)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(n, v(1,j+1), ax)
call mv(n, v(1,j+1), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
80 continue
c
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NDRV5 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sndrv5. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n), w(n), one, four
parameter (one = 1.0E+0, four = 4.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)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), three, two
parameter (three = 3.0E+0, two = 2.0E+0)
c
c Compute the matrix vector multiplication y<---A*x
c where M is a n by n symmetric tridiagonal matrix with 2 on the
c diagonal, -2 on the subdiagonal and 3 on the superdiagonal.
c
w(1) = two*v(1) + three*v(2)
do 10 j = 2,n-1
w(j) = -two*v(j-1) + two*v(j) + three*v(j+1)
10 continue
w(n) = -two*v(n-1) + two*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/ 0000755 0001750 0001750 00000000000 12277671461 012726 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/COMPLEX/zndrv2.f 0000644 0001750 0001750 00000035204 12277373057 014246 0000000 0000000 program zndrv2
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a standard complex nonsymmetric eigenvalue
c problem.
c
c We implement example two of ex-complex.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the central difference discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u/dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition.
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
c\BeginLib
c
c\Routines called:
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 av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv2.F SID: 2.6 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
Complex*16
& h, h2, s, sigma, s1, s2, s3, rho
common /convct/ rho
c
Double precision
& tol
logical rvec
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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external zgttrf , zgttrs , zaxpy , zcopy , dznrm2 ,
& dlapy2
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = |
c | 'I'). NEV is the number of eigenvalues (closest |
c | to the shift SIGMA) to be approximated. Since |
c | the shift-invert mode is used, WHICH is set to |
c | 'LM'. The user can modify NEV, NCV, SIGMA to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %----------------------------------------------------%
c | Construct C = A - SIGMA*I, factor C in complex |
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 | the interval [0, 1] with zero Dirichlet boundary |
c | condition. |
c %----------------------------------------------------%
c
rho = (1.0D+1, 0.0D+0)
h = one / dcmplx (n+1)
h2 = h*h
s = rho / two
c
s1 = -one/h2 - s/h
s2 = two/h2 - sigma
s3 = -one/h2 + s/h
c
do 10 j = 1, n-1
dl(j) = s1
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
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,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1 ) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*I]*x |
c | The user should supply his/her own linear |
c | system solver here that takes |
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)
c
call zgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
else
c
nconv = iparam(5)
do 60 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
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))
60 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV2 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program zndrv2 . |
c %---------------------------%
c
9000 continue
c
end
c
c-------------------------------------------------------------------
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
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) )
common /convct/ rho
c
h = one / dcmplx (n+1)
h2 = h*h
s = rho / two
dd = two / h2
dl = -one/h2 - s/h
du = -one/h2 + s/h
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/README 0000644 0001750 0001750 00000002712 12277373057 013530 0000000 0000000 1. Purpose
-------
This directory contains example drivers that call ARPACK subroutines
[c,z]naupd.f and [c,z]neupd.f to solve COMPLEX eigenvalue problems
using regular, inverse or shift-invert modes. These drivers illustrate
how to set various ARPACK parameters to solve different problems in
different modes. They provide a guideline on how to use ARPACK's reverse
communication interface. The user may modify any one of these drivers,
and provide his/her own matrix vector multiplication routine to solve
the problem of his/her own interest.
2. Naming convention
-----------------
The name for each driver has the form 'XndrvN.f', where
X - is 'c' (single precision complex)
or 'z' (double precision complex)
N - is a number between 1 and 4. If
N = 1, the driver solves a STANDARD eigenvalue problem in
REGULAR mode
N = 2, the driver solves a STANDARD eigenvalue problem in
SHIFT-INVERT mode.
N = 3, the driver solves a GENERALIZED eigenvalue problem in
INVERSE mode
N = 4, the driver solves a GENERALIZED eigenvalue problem in
SHIFT-INVERT mode.
For shift-invert modes (N=2,4), the user needs to provide a complex
linear system solver to perform y=inv[A-sigma*B]*x.
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make cndrv1". Then
execute using "cndrv1".
arpack-ng-3.1.5/EXAMPLES/COMPLEX/Makefile.am 0000644 0001750 0001750 00000001520 12277670164 014677 0000000 0000000 check_PROGRAMS = cndrv1 cndrv2 cndrv3 cndrv4 zndrv1 zndrv2 zndrv3 zndrv4
cndrv1_SOURCES = cndrv1.f
cndrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv2_SOURCES = cndrv2.f
cndrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv3_SOURCES = cndrv3.f
cndrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv4_SOURCES = cndrv4.f
cndrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv1_SOURCES = zndrv1.f
zndrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv2_SOURCES = zndrv2.f
zndrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv3_SOURCES = zndrv3.f
zndrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv4_SOURCES = zndrv4.f
zndrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = cndrv1 cndrv2 cndrv3 cndrv4 zndrv1 zndrv2 zndrv3 zndrv4
arpack-ng-3.1.5/EXAMPLES/COMPLEX/cndrv2.f 0000644 0001750 0001750 00000035051 12277373057 014217 0000000 0000000 program cndrv2
c
c Simple program to illustrate the idea of reverse communication
c in shift-invert mode for a standard complex nonsymmetric eigenvalue
c problem.
c
c We implement example two of ex-complex.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the central difference discretization
c of the 1-dimensional convection-diffusion operator
c (d^2u/dx^2) + rho*(du/dx)
c on the interval [0,1] with zero Dirichlet boundary condition.
c ... The shift sigma is a complex number.
c
c ... OP = inv[A-sigma*I] and B = I.
c
c ... Use mode 3 of CNAUPD.
c
c\BeginLib
c
c\Routines called:
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgttrf LAPACK tridiagonal factorization routine.
c cgttrs LAPACK tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c ccopy Level 1 BLAS that copies one vector to another.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv2.F SID: 2.6 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
Complex
& h, h2, s, sigma, s1, s2, s3, rho
common /convct/ rho
c
Real
& tol
logical rvec
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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external cgttrf, cgttrs, caxpy, ccopy, scnrm2,
& slapy2
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = |
c | 'I'). NEV is the number of eigenvalues (closest |
c | to the shift SIGMA) to be approximated. Since |
c | the shift-invert mode is used, WHICH is set to |
c | 'LM'. The user can modify NEV, NCV, SIGMA to |
c | solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %----------------------------------------------------%
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 | the interval [0, 1] with zero Dirichlet boundary |
c | condition. |
c %----------------------------------------------------%
c
rho = (1.0E+1, 0.0E+0)
h = one / cmplx(n+1)
h2 = h*h
s = rho / two
c
s1 = -one/h2 - s/h
s2 = two/h2 - sigma
s3 = -one/h2 + s/h
c
do 10 j = 1, n-1
dl(j) = s1
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call cgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 CNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1 ) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*I]*x |
c | The user should supply his/her own linear |
c | system solver here that takes |
c | workd(ipntr(1)) as the input, and returns |
c | the result to workd(ipntr(2)). |
c %-------------------------------------------%
c
call ccopy( n, workd(ipntr(1)),1, workd(ipntr(2)), 1)
c
call cgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV2.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation in _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call cneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
else
c
nconv = iparam(5)
do 60 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
60 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV2 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program cndrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c-------------------------------------------------------------------
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
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) )
common /convct/ rho
c
h = one / cmplx(n+1)
h2 = h*h
s = rho / two
dd = two / h2
dl = -one/h2 - s/h
du = -one/h2 + s/h
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/zndrv4.f 0000644 0001750 0001750 00000042210 12277373057 014243 0000000 0000000 program zndrv4
c
c Simple program to illustrate the idea of reverse communication
c in shift and invert mode for a generalized complex nonsymmetric
c eigenvalue problem.
c
c We implement example four of ex-complex.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode,
c where A and B are derived from a finite element discretization
c of a 1-dimensional convection-diffusion operator
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 ... 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
c\BeginLib
c
c\Routines called:
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 av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv4.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
Complex*16
& rho, h, s,
& sigma, s1, s2, s3
common /convct/ rho
c
Double precision
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zaxpy , zcopy , zgttrf , zgttrs ,
& dlapy2
c
c %------------%
c | Parameters |
c %------------%
c
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 |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to SIGMAR) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMA to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = one
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 | 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 | 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)
s = rho / two
c
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
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
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,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force starting vector into the range |
c | of OP. The user should supply his/her |
c | own matrix vector multiplication routine |
c | and a linear system solver. The matrix |
c | vector multiplication routine should take |
c | workd(ipntr(1)) as the input. The final |
c | result should be returned to |
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,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(3)) |
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,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
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 %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %----------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %----------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 80 j=1, nconv
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))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV4 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
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) ) / six
do 40 j = 2,n-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) ) / six
c
h = one / dcmplx (n+1)
call zscal (n, h, w, 1)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
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) )
common /convct/ rho
c
h = one / dcmplx (n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 40 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
40 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/Makefile 0000644 0001750 0001750 00000106614 12277671461 014316 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/COMPLEX/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = cndrv1$(EXEEXT) cndrv2$(EXEEXT) cndrv3$(EXEEXT) \
cndrv4$(EXEEXT) zndrv1$(EXEEXT) zndrv2$(EXEEXT) \
zndrv3$(EXEEXT) zndrv4$(EXEEXT)
TESTS = cndrv1$(EXEEXT) cndrv2$(EXEEXT) cndrv3$(EXEEXT) \
cndrv4$(EXEEXT) zndrv1$(EXEEXT) zndrv2$(EXEEXT) \
zndrv3$(EXEEXT) zndrv4$(EXEEXT)
subdir = EXAMPLES/COMPLEX
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cndrv1_OBJECTS = cndrv1.$(OBJEXT)
cndrv1_OBJECTS = $(am_cndrv1_OBJECTS)
am__DEPENDENCIES_1 =
cndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_cndrv2_OBJECTS = cndrv2.$(OBJEXT)
cndrv2_OBJECTS = $(am_cndrv2_OBJECTS)
cndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cndrv3_OBJECTS = cndrv3.$(OBJEXT)
cndrv3_OBJECTS = $(am_cndrv3_OBJECTS)
cndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cndrv4_OBJECTS = cndrv4.$(OBJEXT)
cndrv4_OBJECTS = $(am_cndrv4_OBJECTS)
cndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv1_OBJECTS = zndrv1.$(OBJEXT)
zndrv1_OBJECTS = $(am_zndrv1_OBJECTS)
zndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv2_OBJECTS = zndrv2.$(OBJEXT)
zndrv2_OBJECTS = $(am_zndrv2_OBJECTS)
zndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv3_OBJECTS = zndrv3.$(OBJEXT)
zndrv3_OBJECTS = $(am_zndrv3_OBJECTS)
zndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv4_OBJECTS = zndrv4.$(OBJEXT)
zndrv4_OBJECTS = $(am_zndrv4_OBJECTS)
zndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cndrv1_SOURCES) $(cndrv2_SOURCES) $(cndrv3_SOURCES) \
$(cndrv4_SOURCES) $(zndrv1_SOURCES) $(zndrv2_SOURCES) \
$(zndrv3_SOURCES) $(zndrv4_SOURCES)
DIST_SOURCES = $(cndrv1_SOURCES) $(cndrv2_SOURCES) $(cndrv3_SOURCES) \
$(cndrv4_SOURCES) $(zndrv1_SOURCES) $(zndrv2_SOURCES) \
$(zndrv3_SOURCES) $(zndrv4_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/COMPLEX
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/COMPLEX
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
cndrv1_SOURCES = cndrv1.f
cndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv2_SOURCES = cndrv2.f
cndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv3_SOURCES = cndrv3.f
cndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv4_SOURCES = cndrv4.f
cndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv1_SOURCES = zndrv1.f
zndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv2_SOURCES = zndrv2.f
zndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv3_SOURCES = zndrv3.f
zndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv4_SOURCES = zndrv4.f
zndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/COMPLEX/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/COMPLEX/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cndrv1$(EXEEXT): $(cndrv1_OBJECTS) $(cndrv1_DEPENDENCIES) $(EXTRA_cndrv1_DEPENDENCIES)
@rm -f cndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv1_OBJECTS) $(cndrv1_LDADD) $(LIBS)
cndrv2$(EXEEXT): $(cndrv2_OBJECTS) $(cndrv2_DEPENDENCIES) $(EXTRA_cndrv2_DEPENDENCIES)
@rm -f cndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv2_OBJECTS) $(cndrv2_LDADD) $(LIBS)
cndrv3$(EXEEXT): $(cndrv3_OBJECTS) $(cndrv3_DEPENDENCIES) $(EXTRA_cndrv3_DEPENDENCIES)
@rm -f cndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv3_OBJECTS) $(cndrv3_LDADD) $(LIBS)
cndrv4$(EXEEXT): $(cndrv4_OBJECTS) $(cndrv4_DEPENDENCIES) $(EXTRA_cndrv4_DEPENDENCIES)
@rm -f cndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv4_OBJECTS) $(cndrv4_LDADD) $(LIBS)
zndrv1$(EXEEXT): $(zndrv1_OBJECTS) $(zndrv1_DEPENDENCIES) $(EXTRA_zndrv1_DEPENDENCIES)
@rm -f zndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv1_OBJECTS) $(zndrv1_LDADD) $(LIBS)
zndrv2$(EXEEXT): $(zndrv2_OBJECTS) $(zndrv2_DEPENDENCIES) $(EXTRA_zndrv2_DEPENDENCIES)
@rm -f zndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv2_OBJECTS) $(zndrv2_LDADD) $(LIBS)
zndrv3$(EXEEXT): $(zndrv3_OBJECTS) $(zndrv3_DEPENDENCIES) $(EXTRA_zndrv3_DEPENDENCIES)
@rm -f zndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv3_OBJECTS) $(zndrv3_LDADD) $(LIBS)
zndrv4$(EXEEXT): $(zndrv4_OBJECTS) $(zndrv4_DEPENDENCIES) $(EXTRA_zndrv4_DEPENDENCIES)
@rm -f zndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv4_OBJECTS) $(zndrv4_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cndrv1.log: cndrv1$(EXEEXT)
@p='cndrv1$(EXEEXT)'; \
b='cndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv2.log: cndrv2$(EXEEXT)
@p='cndrv2$(EXEEXT)'; \
b='cndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv3.log: cndrv3$(EXEEXT)
@p='cndrv3$(EXEEXT)'; \
b='cndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv4.log: cndrv4$(EXEEXT)
@p='cndrv4$(EXEEXT)'; \
b='cndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv1.log: zndrv1$(EXEEXT)
@p='zndrv1$(EXEEXT)'; \
b='zndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv2.log: zndrv2$(EXEEXT)
@p='zndrv2$(EXEEXT)'; \
b='zndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv3.log: zndrv3$(EXEEXT)
@p='zndrv3$(EXEEXT)'; \
b='zndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv4.log: zndrv4$(EXEEXT)
@p='zndrv4$(EXEEXT)'; \
b='zndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/COMPLEX/zndrv1.f 0000644 0001750 0001750 00000035205 12277373057 014246 0000000 0000000 program zndrv1
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit squre [0,1]x[0,1] with zero Dirichlet boundary
c condition.
c
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
c\BeginLib
c
c\Routines called
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 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv1.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
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
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex*16
& sigma
Double precision
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zaxpy , dlapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
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 %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
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))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program zndrv1 . |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Complex*16
& v(nx*nx), w(nx*nx), one, h2
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
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c
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)
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)
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)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex*16
& x(nx), y(nx), h, h2, dd, dl, du
c
Complex*16
& one, rho
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)
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
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/Makefile.in 0000644 0001750 0001750 00000104741 12277670174 014722 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = cndrv1$(EXEEXT) cndrv2$(EXEEXT) cndrv3$(EXEEXT) \
cndrv4$(EXEEXT) zndrv1$(EXEEXT) zndrv2$(EXEEXT) \
zndrv3$(EXEEXT) zndrv4$(EXEEXT)
TESTS = cndrv1$(EXEEXT) cndrv2$(EXEEXT) cndrv3$(EXEEXT) \
cndrv4$(EXEEXT) zndrv1$(EXEEXT) zndrv2$(EXEEXT) \
zndrv3$(EXEEXT) zndrv4$(EXEEXT)
subdir = EXAMPLES/COMPLEX
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cndrv1_OBJECTS = cndrv1.$(OBJEXT)
cndrv1_OBJECTS = $(am_cndrv1_OBJECTS)
am__DEPENDENCIES_1 =
cndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_cndrv2_OBJECTS = cndrv2.$(OBJEXT)
cndrv2_OBJECTS = $(am_cndrv2_OBJECTS)
cndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cndrv3_OBJECTS = cndrv3.$(OBJEXT)
cndrv3_OBJECTS = $(am_cndrv3_OBJECTS)
cndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cndrv4_OBJECTS = cndrv4.$(OBJEXT)
cndrv4_OBJECTS = $(am_cndrv4_OBJECTS)
cndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv1_OBJECTS = zndrv1.$(OBJEXT)
zndrv1_OBJECTS = $(am_zndrv1_OBJECTS)
zndrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv2_OBJECTS = zndrv2.$(OBJEXT)
zndrv2_OBJECTS = $(am_zndrv2_OBJECTS)
zndrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv3_OBJECTS = zndrv3.$(OBJEXT)
zndrv3_OBJECTS = $(am_zndrv3_OBJECTS)
zndrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_zndrv4_OBJECTS = zndrv4.$(OBJEXT)
zndrv4_OBJECTS = $(am_zndrv4_OBJECTS)
zndrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cndrv1_SOURCES) $(cndrv2_SOURCES) $(cndrv3_SOURCES) \
$(cndrv4_SOURCES) $(zndrv1_SOURCES) $(zndrv2_SOURCES) \
$(zndrv3_SOURCES) $(zndrv4_SOURCES)
DIST_SOURCES = $(cndrv1_SOURCES) $(cndrv2_SOURCES) $(cndrv3_SOURCES) \
$(cndrv4_SOURCES) $(zndrv1_SOURCES) $(zndrv2_SOURCES) \
$(zndrv3_SOURCES) $(zndrv4_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
cndrv1_SOURCES = cndrv1.f
cndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv2_SOURCES = cndrv2.f
cndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv3_SOURCES = cndrv3.f
cndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cndrv4_SOURCES = cndrv4.f
cndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv1_SOURCES = zndrv1.f
zndrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv2_SOURCES = zndrv2.f
zndrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv3_SOURCES = zndrv3.f
zndrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
zndrv4_SOURCES = zndrv4.f
zndrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/COMPLEX/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/COMPLEX/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cndrv1$(EXEEXT): $(cndrv1_OBJECTS) $(cndrv1_DEPENDENCIES) $(EXTRA_cndrv1_DEPENDENCIES)
@rm -f cndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv1_OBJECTS) $(cndrv1_LDADD) $(LIBS)
cndrv2$(EXEEXT): $(cndrv2_OBJECTS) $(cndrv2_DEPENDENCIES) $(EXTRA_cndrv2_DEPENDENCIES)
@rm -f cndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv2_OBJECTS) $(cndrv2_LDADD) $(LIBS)
cndrv3$(EXEEXT): $(cndrv3_OBJECTS) $(cndrv3_DEPENDENCIES) $(EXTRA_cndrv3_DEPENDENCIES)
@rm -f cndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv3_OBJECTS) $(cndrv3_LDADD) $(LIBS)
cndrv4$(EXEEXT): $(cndrv4_OBJECTS) $(cndrv4_DEPENDENCIES) $(EXTRA_cndrv4_DEPENDENCIES)
@rm -f cndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cndrv4_OBJECTS) $(cndrv4_LDADD) $(LIBS)
zndrv1$(EXEEXT): $(zndrv1_OBJECTS) $(zndrv1_DEPENDENCIES) $(EXTRA_zndrv1_DEPENDENCIES)
@rm -f zndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv1_OBJECTS) $(zndrv1_LDADD) $(LIBS)
zndrv2$(EXEEXT): $(zndrv2_OBJECTS) $(zndrv2_DEPENDENCIES) $(EXTRA_zndrv2_DEPENDENCIES)
@rm -f zndrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv2_OBJECTS) $(zndrv2_LDADD) $(LIBS)
zndrv3$(EXEEXT): $(zndrv3_OBJECTS) $(zndrv3_DEPENDENCIES) $(EXTRA_zndrv3_DEPENDENCIES)
@rm -f zndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv3_OBJECTS) $(zndrv3_LDADD) $(LIBS)
zndrv4$(EXEEXT): $(zndrv4_OBJECTS) $(zndrv4_DEPENDENCIES) $(EXTRA_zndrv4_DEPENDENCIES)
@rm -f zndrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(zndrv4_OBJECTS) $(zndrv4_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cndrv1.log: cndrv1$(EXEEXT)
@p='cndrv1$(EXEEXT)'; \
b='cndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv2.log: cndrv2$(EXEEXT)
@p='cndrv2$(EXEEXT)'; \
b='cndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv3.log: cndrv3$(EXEEXT)
@p='cndrv3$(EXEEXT)'; \
b='cndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cndrv4.log: cndrv4$(EXEEXT)
@p='cndrv4$(EXEEXT)'; \
b='cndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv1.log: zndrv1$(EXEEXT)
@p='zndrv1$(EXEEXT)'; \
b='zndrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv2.log: zndrv2$(EXEEXT)
@p='zndrv2$(EXEEXT)'; \
b='zndrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv3.log: zndrv3$(EXEEXT)
@p='zndrv3$(EXEEXT)'; \
b='zndrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
zndrv4.log: zndrv4$(EXEEXT)
@p='zndrv4$(EXEEXT)'; \
b='zndrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/COMPLEX/cndrv3.f 0000644 0001750 0001750 00000036734 12277373057 014231 0000000 0000000 program cndrv3
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized complex nonsymmetric eigenvalue
c problem.
c
c We implement example three of ex-complex.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in regular mode,
c where A and B are derived from the finite element discretization
c 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 using
c piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
c ... Use mode 2 of CNAUPD.
c
c\BeginLib
c
c\Routines called:
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgttrf LAPACK tridiagonal factorization routine.
c cgttrs LAPACK tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c scnrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv3.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Complex
& sigma, h
Real
& tol
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& zero, one
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
& scnrm2, slapy2
external caxpy, ccopy, scnrm2, cgttrf, cgttrs,
& slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
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 | cgttrf. |
c %-----------------------------------------------------%
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
du(j) = one*h
20 continue
dd(n) = (4.0E+0, 0.0E+0) *h
c
call cgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 CNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call cgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in CNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call cneupd ( rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv, v,
& ldv, iparam, ipntr, workd, workl, lworkl, rwork,
& ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
c
else
c
nconv = iparam(5)
do 80 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated ',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
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) )
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 / cmplx(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
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) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear elements
c on [0,1].
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
c
h = one / cmplx(n+1)
call cscal(n, h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/zndrv3.f 0000644 0001750 0001750 00000037073 12277373057 014255 0000000 0000000 program zndrv3
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized complex nonsymmetric eigenvalue
c problem.
c
c We implement example three of ex-complex.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in regular mode,
c where A and B are derived from the finite element discretization
c 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 using
c piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
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 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 av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv3.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode
Complex*16
& sigma, h
Double precision
& tol
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& zero, one
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
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
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 %-----------------------------------------------------%
c
h = one / dcmplx (n+1)
do 20 j = 1, n-1
dl(j) = one*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
c
call zgttrf (n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
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,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
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 %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in ZNAUPD . |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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 )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
c
else
c
nconv = iparam(5)
do 80 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated ',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine av (n, v, w)
integer n, j
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) )
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)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
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) )
c
c Compute the matrix vector multiplication y<---M*x
c where M is the mass matrix formed by using piecewise linear elements
c on [0,1].
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,n-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(n) = one*v(n-1) + four*v(n)
c
h = one / dcmplx (n+1)
call zscal (n, h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/cndrv4.f 0000644 0001750 0001750 00000042045 12277373057 014222 0000000 0000000 program cndrv4
c
c Simple program to illustrate the idea of reverse communication
c in shift and invert mode for a generalized complex nonsymmetric
c eigenvalue problem.
c
c We implement example four of ex-complex.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*B*x in shift-invert mode,
c where A and B are derived from a finite element discretization
c of a 1-dimensional convection-diffusion operator
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 ... 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 CNAUPD.
c
c\BeginLib
c
c\Routines called:
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgttrf LAPACK tridiagonal factorization routine.
c cgttrs LAPACK tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c ccopy Level 1 BLAS that copies one vector to another.
c scnrm2 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
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv4.F SID: 2.4 DATE OF SID: 10/18/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), ipiv(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
Complex
& rho, h, s,
& sigma, s1, s2, s3
common /convct/ rho
c
Real
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, caxpy, ccopy, cgttrf, cgttrs,
& slapy2
c
c %------------%
c | Parameters |
c %------------%
c
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 |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues (closest |
c | to SIGMAR) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMA to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = one
c
c %--------------------------------------------------%
c | Construct C = A - SIGMA*M in COMPLEX arithmetic. |
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 | 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)
h = one / cmplx(n+1)
s = rho / two
c
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
dd(j) = s2
du(j) = s3
10 continue
dd(n) = s2
c
call cgttrf(n, dl, dd, du, du2, ipiv, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrf in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 CNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 3). All these options can be |
c | changed by the user. For details see the |
c | documentation in CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------%
c | M A I N L O O P(Reverse communication) |
c %------------------------------------------%
c
20 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force starting vector into the range |
c | of OP. The user should supply his/her |
c | own matrix vector multiplication routine |
c | and a linear system solver. The matrix |
c | vector multiplication routine should take |
c | workd(ipntr(1)) as the input. The final |
c | result should be returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
call cgttrs('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(3)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call ccopy( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call cgttrs ('N', n, 1, dl, dd, du, du2, ipiv,
& workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _gttrs in _NDRV4.'
print*, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
else if ( ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- M*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 20
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %----------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %----------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call cneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv, v,
& ldv, iparam, ipntr, workd, workl, lworkl, rwork,
& ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 80 j=1, nconv
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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
80 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
c
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV4 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector multiplication subroutine
c
subroutine mv (n, v, w)
integer n, j
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) ) / six
do 40 j = 2,n-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) ) / six
c
h = one / cmplx(n+1)
call cscal(n, h, w, 1)
return
end
c------------------------------------------------------------------
subroutine av (n, v, w)
integer n, j
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) )
common /convct/ rho
c
h = one / cmplx(n+1)
s = rho / two
dd = two / h
dl = -one/h - s
du = -one/h + s
c
w(1) = dd*v(1) + du*v(2)
do 40 j = 2,n-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
40 continue
w(n) = dl*v(n-1) + dd*v(n)
return
end
arpack-ng-3.1.5/EXAMPLES/COMPLEX/cndrv1.f 0000644 0001750 0001750 00000035055 12277373057 014222 0000000 0000000 program cndrv1
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit squre [0,1]x[0,1] with zero Dirichlet boundary
c condition.
c
c ... OP = A and B = I.
c
c ... Assume "call av (nx,x,y)" computes y = A*x
c
c ... Use mode 1 of CNAUPD.
c
c\BeginLib
c
c\Routines called
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scnrm2 Level 1 BLAS that computes the norm of a complex vector.
c caxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ndrv1.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex
& sigma
Real
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, caxpy, slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call cneupd (rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program cndrv1. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Complex
& v(nx*nx), w(nx*nx), one, h2
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
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c
h2 = one / cmplx((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call caxpy(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 caxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call caxpy(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 caxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex
& x(nx), y(nx), h, h2, dd, dl, du
c
Complex
& one, rho
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
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
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/ 0000755 0001750 0001750 00000000000 12277671461 012610 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/SIMPLE/debug.h 0000644 0001750 0001750 00000001351 12277373057 013767 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/EXAMPLES/SIMPLE/README 0000644 0001750 0001750 00000001517 12277373057 013414 0000000 0000000 1. Purpose
-------
This directory contains simple example drivers that call ARPACK subroutine
__aupd.f and __eupd.f to solve various eigenvalue problems using regular
mode. These drivers illustrate how to use ARPACK in considerable detail.
If you have never used ARPACK before, this is the place to start.
2. Naming Convention
-----------------
The name for each driver has the form 'XYsimp.f', where
X - is 's' (single precision)
or 'd' (double precision)
or 'c' (single complex)
or 'z' (double complex)
Y - is 's' (symmetric)
or 'n' (nonsymmetric)
Note: there is no simple driver specifically for hermitian complex.
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make sssimp". Then
execute using "sssimp".
arpack-ng-3.1.5/EXAMPLES/SIMPLE/Makefile.am 0000644 0001750 0001750 00000001204 12277670164 014560 0000000 0000000 check_PROGRAMS = cnsimp dnsimp dssimp snsimp sssimp znsimp
cnsimp_SOURCES = cnsimp.f
cnsimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnsimp_SOURCES = dnsimp.f
dnsimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dssimp_SOURCES = dssimp.f
dssimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snsimp_SOURCES = snsimp.f
snsimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sssimp_SOURCES = sssimp.f
sssimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znsimp_SOURCES = znsimp.f
znsimp_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = cnsimp dnsimp dssimp snsimp sssimp znsimp
arpack-ng-3.1.5/EXAMPLES/SIMPLE/snsimp.f 0000644 0001750 0001750 00000053516 12277373057 014222 0000000 0000000 program snsimp
c
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is a n by n real nonsymmetric matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 SNAUPD
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 SNEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-nonsym.doc in DOCUMENTS directory.
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (nx,x,y)" computes y = A*x
c ... Use mode 1 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nsimp.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting mnaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
mnaitr = 0
mnapps = 0
mnaupd = 1
mnaup2 = 0
mneigh = 0
mneupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization. |
c | |
c | 3) This is a standard problem. |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude. |
c | (indicated by which = 'LM') |
c | See documentation in SNAUPD for the |
c | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c | |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _NSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling SNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 SNAUPD. (see usage below) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to SNAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 SNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 SNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call snaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- Op*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
endif
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
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 SNEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1,) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
call sneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %------------------------------------------------%
c | The real parts of the eigenvalues are returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part are returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first |
c | NCONV (= IPARAM(5)) columns of the two |
c | dimensional array V if requested. Otherwise, |
c | an orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %------------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (IPARAM(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call av(nx, v(1,j+1), ax)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real, Imag) and residual residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NSIMP '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program snsimp. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Real
& v(nx*nx), w(nx*nx), one, h2
parameter (one = 1.0E+0)
external saxpy, tv
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has complex
c eigenvalues.
c
c The subroutine TV is called to computed y<---T*x.
c
c
h2 = one / real((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call saxpy(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 saxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(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 saxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), h, dd, dl, du, h2
c
Real
& one, rho
parameter (one = 1.0E+0, rho = 1.0E+2)
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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has complex
c eigenvalues.
c
h = one / real(nx+1)
h2 = h*h
dd = 4.0E+0 / h2
dl = -one/h2 - 5.0E-1*rho/h
du = -one/h2 + 5.0E-1*rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/dnsimp.f 0000644 0001750 0001750 00000053642 12277373057 014203 0000000 0000000 program dnsimp
c
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is a n by n real nonsymmetric matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 DNAUPD
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 DNEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-nonsym.doc in DOCUMENTS directory.
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (nx,x,y)" computes y = A*x
c ... Use mode 1 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nsimp.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting mnaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
mnaitr = 0
mnapps = 0
mnaupd = 1
mnaup2 = 0
mneigh = 0
mneupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization. |
c | |
c | 3) This is a standard problem. |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude. |
c | (indicated by which = 'LM') |
c | See documentation in DNAUPD for the |
c | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c | |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _NSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling DNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 DNAUPD. (see usage below) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to DNAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 DNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- Op*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
endif
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
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 DNEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1,) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %------------------------------------------------%
c | The real parts of the eigenvalues are returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part are returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first |
c | NCONV (= IPARAM(5)) columns of the two |
c | dimensional array V if requested. Otherwise, |
c | an orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %------------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (IPARAM(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(nx, v(1,j), ax)
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
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(nx, v(1,j), ax)
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 av(nx, v(1,j+1), ax)
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
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real, Imag) and residual residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NSIMP '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dnsimp. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Double precision
& v(nx*nx), w(nx*nx), one, h2
parameter (one = 1.0D+0)
external daxpy, tv
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has complex
c eigenvalues.
c
c The subroutine TV is called to computed y<---T*x.
c
c
h2 = one / dble((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call daxpy(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 daxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(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 daxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), h, dd, dl, du, h2
c
Double precision
& one, rho
parameter (one = 1.0D+0, rho = 1.0D+2)
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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has complex
c eigenvalues.
c
h = one / dble(nx+1)
h2 = h*h
dd = 4.0D+0 / h2
dl = -one/h2 - 5.0D-1*rho/h
du = -one/h2 + 5.0D-1*rho/h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/cnsimp.f 0000644 0001750 0001750 00000050602 12277373057 014173 0000000 0000000 program cnsimp
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is a general n by n complex matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 CNAUPD
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 CNEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-complex.doc in DOCUMENTS directory.
c This codes implements
c
c
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 CNAUPD.
c
c\BeginLib
c
c\Routines called
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scnrm2 Level 1 BLAS that computes the norm of a complex vector.
c caxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nsimp.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(2*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
Complex
& sigma
Real
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, caxpy, slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting mcaupd = 1 |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
mcaitr = 0
mcapps = 0
mcaupd = 1
mcaup2 = 0
mceigh = 0
mceupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude |
c | (indicated by which = 'LM') |
c | See documentation in CNAUPD for the |
c | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c | |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _NSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling CNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 CNAUPD. (see usage below) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to CNAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 CNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 CNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse Communication Loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | |
c | y <--- A*x |
c | |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector x , and returns the resulting |
c | matrix-vector product y = A*x in the |
c | array workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
endif
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
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 CNEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1.) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
call cneupd (rvec, 'A', select, D, V, ldv, sigma,
& workev, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %-----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D and the corresponding |
c | eigenvectors are returned in the first |
c | NCONV (=IPARAM(5)) columns of the two |
c | dimensional array V if requested. Otherwise, |
c | an orthogonal basis for the invariant |
c | subspace corresponding to the eigenvalues in |
c | D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NSIMP '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program cnsimp. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Complex
& v(nx*nx), w(nx*nx), one, h2
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
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2-dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx)
c on the unit squqre with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c
h2 = one / cmplx((nx+1)*(nx+1))
c
call tv(nx,v(1),w(1))
call caxpy(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 caxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
call caxpy(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 caxpy(nx, -one/h2, v(lo-nx+1), 1, w(lo+1), 1)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex
& x(nx), y(nx), h, h2, dd, dl, du
c
Complex
& one, rho
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
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
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/Makefile 0000644 0001750 0001750 00000103532 12277671461 014174 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/SIMPLE/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = cnsimp$(EXEEXT) dnsimp$(EXEEXT) dssimp$(EXEEXT) \
snsimp$(EXEEXT) sssimp$(EXEEXT) znsimp$(EXEEXT)
TESTS = cnsimp$(EXEEXT) dnsimp$(EXEEXT) dssimp$(EXEEXT) \
snsimp$(EXEEXT) sssimp$(EXEEXT) znsimp$(EXEEXT)
subdir = EXAMPLES/SIMPLE
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cnsimp_OBJECTS = cnsimp.$(OBJEXT)
cnsimp_OBJECTS = $(am_cnsimp_OBJECTS)
am__DEPENDENCIES_1 =
cnsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_dnsimp_OBJECTS = dnsimp.$(OBJEXT)
dnsimp_OBJECTS = $(am_dnsimp_OBJECTS)
dnsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dssimp_OBJECTS = dssimp.$(OBJEXT)
dssimp_OBJECTS = $(am_dssimp_OBJECTS)
dssimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snsimp_OBJECTS = snsimp.$(OBJEXT)
snsimp_OBJECTS = $(am_snsimp_OBJECTS)
snsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sssimp_OBJECTS = sssimp.$(OBJEXT)
sssimp_OBJECTS = $(am_sssimp_OBJECTS)
sssimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znsimp_OBJECTS = znsimp.$(OBJEXT)
znsimp_OBJECTS = $(am_znsimp_OBJECTS)
znsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cnsimp_SOURCES) $(dnsimp_SOURCES) $(dssimp_SOURCES) \
$(snsimp_SOURCES) $(sssimp_SOURCES) $(znsimp_SOURCES)
DIST_SOURCES = $(cnsimp_SOURCES) $(dnsimp_SOURCES) $(dssimp_SOURCES) \
$(snsimp_SOURCES) $(sssimp_SOURCES) $(znsimp_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SIMPLE
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SIMPLE
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
cnsimp_SOURCES = cnsimp.f
cnsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnsimp_SOURCES = dnsimp.f
dnsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dssimp_SOURCES = dssimp.f
dssimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snsimp_SOURCES = snsimp.f
snsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sssimp_SOURCES = sssimp.f
sssimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znsimp_SOURCES = znsimp.f
znsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SIMPLE/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SIMPLE/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cnsimp$(EXEEXT): $(cnsimp_OBJECTS) $(cnsimp_DEPENDENCIES) $(EXTRA_cnsimp_DEPENDENCIES)
@rm -f cnsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnsimp_OBJECTS) $(cnsimp_LDADD) $(LIBS)
dnsimp$(EXEEXT): $(dnsimp_OBJECTS) $(dnsimp_DEPENDENCIES) $(EXTRA_dnsimp_DEPENDENCIES)
@rm -f dnsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnsimp_OBJECTS) $(dnsimp_LDADD) $(LIBS)
dssimp$(EXEEXT): $(dssimp_OBJECTS) $(dssimp_DEPENDENCIES) $(EXTRA_dssimp_DEPENDENCIES)
@rm -f dssimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dssimp_OBJECTS) $(dssimp_LDADD) $(LIBS)
snsimp$(EXEEXT): $(snsimp_OBJECTS) $(snsimp_DEPENDENCIES) $(EXTRA_snsimp_DEPENDENCIES)
@rm -f snsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snsimp_OBJECTS) $(snsimp_LDADD) $(LIBS)
sssimp$(EXEEXT): $(sssimp_OBJECTS) $(sssimp_DEPENDENCIES) $(EXTRA_sssimp_DEPENDENCIES)
@rm -f sssimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sssimp_OBJECTS) $(sssimp_LDADD) $(LIBS)
znsimp$(EXEEXT): $(znsimp_OBJECTS) $(znsimp_DEPENDENCIES) $(EXTRA_znsimp_DEPENDENCIES)
@rm -f znsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znsimp_OBJECTS) $(znsimp_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cnsimp.log: cnsimp$(EXEEXT)
@p='cnsimp$(EXEEXT)'; \
b='cnsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnsimp.log: dnsimp$(EXEEXT)
@p='dnsimp$(EXEEXT)'; \
b='dnsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dssimp.log: dssimp$(EXEEXT)
@p='dssimp$(EXEEXT)'; \
b='dssimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snsimp.log: snsimp$(EXEEXT)
@p='snsimp$(EXEEXT)'; \
b='snsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sssimp.log: sssimp$(EXEEXT)
@p='sssimp$(EXEEXT)'; \
b='sssimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znsimp.log: znsimp$(EXEEXT)
@p='znsimp$(EXEEXT)'; \
b='znsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SIMPLE/dssimp.f 0000644 0001750 0001750 00000047325 12277373057 014211 0000000 0000000 program dssimp
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is an n by n real symmetric matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 DSAUPD
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 DSEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-sym.doc in DOCUMENTS directory.
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x
c ... Use mode 1 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 Ritz vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ssimp.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
$ ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr,
& j, nx, ishfts, maxitr, mode1, nconv
logical rvec
Double precision
& tol, sigma
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external dnrm2, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting msaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
msgets = 0
msaitr = 0
msapps = 0
msaupd = 1
msaup2 = 0
mseigt = 0
mseupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude |
c | (indicated by which = 'LM') |
c | See documentation in DSAUPD for the |
c | other options SM, LA, SA, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _SSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling DSAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 DSAUPD. (See usage below.) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to DSAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
c | |
c | This program uses the exact shift strategy |
c | (indicated by setting PARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 | DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse communication loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in DSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
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 DSEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1.) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
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
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NCONV (=IPARAM(5)) columns of the |
c | two dimensional array V if requested. |
c | Otherwise, an orthogonal basis for the |
c | invariant subspace corresponding to the |
c | eigenvalues in D is returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
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
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SSIMP '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dssimp. |
c %---------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c
subroutine av (nx, v, w)
integer nx, j, lo, n2
Double precision
& v(nx*nx), w(nx*nx), one, h2
parameter ( one = 1.0D+0 )
c
call tv(nx,v(1),w(1))
call daxpy(nx, -one, 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 daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, 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 daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
c Scale the vector w by (1/h^2), where h is the mesh size
c
n2 = nx*nx
h2 = one / dble((nx+1)*(nx+1))
call dscal(n2, one/h2, w, 1)
return
end
c
c-------------------------------------------------------------------
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), dd, dl, du
c
Double precision
& one, four
parameter (one = 1.0D+0, four = 4.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
c
dd = four
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/Makefile.in 0000644 0001750 0001750 00000101662 12277670174 014603 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = cnsimp$(EXEEXT) dnsimp$(EXEEXT) dssimp$(EXEEXT) \
snsimp$(EXEEXT) sssimp$(EXEEXT) znsimp$(EXEEXT)
TESTS = cnsimp$(EXEEXT) dnsimp$(EXEEXT) dssimp$(EXEEXT) \
snsimp$(EXEEXT) sssimp$(EXEEXT) znsimp$(EXEEXT)
subdir = EXAMPLES/SIMPLE
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cnsimp_OBJECTS = cnsimp.$(OBJEXT)
cnsimp_OBJECTS = $(am_cnsimp_OBJECTS)
am__DEPENDENCIES_1 =
cnsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_dnsimp_OBJECTS = dnsimp.$(OBJEXT)
dnsimp_OBJECTS = $(am_dnsimp_OBJECTS)
dnsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dssimp_OBJECTS = dssimp.$(OBJEXT)
dssimp_OBJECTS = $(am_dssimp_OBJECTS)
dssimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snsimp_OBJECTS = snsimp.$(OBJEXT)
snsimp_OBJECTS = $(am_snsimp_OBJECTS)
snsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_sssimp_OBJECTS = sssimp.$(OBJEXT)
sssimp_OBJECTS = $(am_sssimp_OBJECTS)
sssimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znsimp_OBJECTS = znsimp.$(OBJEXT)
znsimp_OBJECTS = $(am_znsimp_OBJECTS)
znsimp_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cnsimp_SOURCES) $(dnsimp_SOURCES) $(dssimp_SOURCES) \
$(snsimp_SOURCES) $(sssimp_SOURCES) $(znsimp_SOURCES)
DIST_SOURCES = $(cnsimp_SOURCES) $(dnsimp_SOURCES) $(dssimp_SOURCES) \
$(snsimp_SOURCES) $(sssimp_SOURCES) $(znsimp_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
cnsimp_SOURCES = cnsimp.f
cnsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnsimp_SOURCES = dnsimp.f
dnsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dssimp_SOURCES = dssimp.f
dssimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snsimp_SOURCES = snsimp.f
snsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
sssimp_SOURCES = sssimp.f
sssimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znsimp_SOURCES = znsimp.f
znsimp_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SIMPLE/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SIMPLE/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cnsimp$(EXEEXT): $(cnsimp_OBJECTS) $(cnsimp_DEPENDENCIES) $(EXTRA_cnsimp_DEPENDENCIES)
@rm -f cnsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnsimp_OBJECTS) $(cnsimp_LDADD) $(LIBS)
dnsimp$(EXEEXT): $(dnsimp_OBJECTS) $(dnsimp_DEPENDENCIES) $(EXTRA_dnsimp_DEPENDENCIES)
@rm -f dnsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnsimp_OBJECTS) $(dnsimp_LDADD) $(LIBS)
dssimp$(EXEEXT): $(dssimp_OBJECTS) $(dssimp_DEPENDENCIES) $(EXTRA_dssimp_DEPENDENCIES)
@rm -f dssimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dssimp_OBJECTS) $(dssimp_LDADD) $(LIBS)
snsimp$(EXEEXT): $(snsimp_OBJECTS) $(snsimp_DEPENDENCIES) $(EXTRA_snsimp_DEPENDENCIES)
@rm -f snsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snsimp_OBJECTS) $(snsimp_LDADD) $(LIBS)
sssimp$(EXEEXT): $(sssimp_OBJECTS) $(sssimp_DEPENDENCIES) $(EXTRA_sssimp_DEPENDENCIES)
@rm -f sssimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(sssimp_OBJECTS) $(sssimp_LDADD) $(LIBS)
znsimp$(EXEEXT): $(znsimp_OBJECTS) $(znsimp_DEPENDENCIES) $(EXTRA_znsimp_DEPENDENCIES)
@rm -f znsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znsimp_OBJECTS) $(znsimp_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cnsimp.log: cnsimp$(EXEEXT)
@p='cnsimp$(EXEEXT)'; \
b='cnsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnsimp.log: dnsimp$(EXEEXT)
@p='dnsimp$(EXEEXT)'; \
b='dnsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dssimp.log: dssimp$(EXEEXT)
@p='dssimp$(EXEEXT)'; \
b='dssimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snsimp.log: snsimp$(EXEEXT)
@p='snsimp$(EXEEXT)'; \
b='snsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
sssimp.log: sssimp$(EXEEXT)
@p='sssimp$(EXEEXT)'; \
b='sssimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znsimp.log: znsimp$(EXEEXT)
@p='znsimp$(EXEEXT)'; \
b='znsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SIMPLE/sssimp.f 0000644 0001750 0001750 00000047201 12277373057 014221 0000000 0000000 program sssimp
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is an n by n real symmetric matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 SSAUPD
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 SSEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-sym.doc in DOCUMENTS directory.
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x
c ... Use mode 1 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: ssimp.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
$ ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr,
& j, nx, ishfts, maxitr, mode1, nconv
logical rvec
Real
& tol, sigma
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external snrm2, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting msaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
msgets = 0
msaitr = 0
msapps = 0
msaupd = 1
msaup2 = 0
mseigt = 0
mseupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude |
c | (indicated by which = 'LM') |
c | See documentation in SSAUPD for the |
c | other options SM, LA, SA, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _SSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling SSAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 SSAUPD. (See usage below.) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to SSAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 SSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
c | |
c | This program uses the exact shift strategy |
c | (indicated by setting PARAM(1) = 1). |
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 1 of SSAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse communication loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in SSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
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 SSEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1.) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NCONV (=IPARAM(5)) columns of the |
c | two dimensional array V if requested. |
c | Otherwise, an orthogonal basis for the |
c | invariant subspace corresponding to the |
c | eigenvalues in D is returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SSIMP '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program sssimp. |
c %---------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c
subroutine av (nx, v, w)
integer nx, j, lo, n2
Real
& v(nx*nx), w(nx*nx), one, h2
parameter ( one = 1.0E+0 )
c
call tv(nx,v(1),w(1))
call saxpy(nx, -one, 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 saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, 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 saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
c Scale the vector w by (1/h^2), where h is the mesh size
c
n2 = nx*nx
h2 = one / real((nx+1)*(nx+1))
call sscal(n2, one/h2, w, 1)
return
end
c
c-------------------------------------------------------------------
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), dd, dl, du
c
Real
& one, four
parameter (one = 1.0E+0, four = 4.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
c diagonal, DL on the subdiagonal, and DU on the superdiagonal.
c
c
dd = four
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SIMPLE/znsimp.f 0000644 0001750 0001750 00000050741 12277373057 014226 0000000 0000000 program znsimp
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is a general n by n complex matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 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
c The only thing that must be supplied in order to use this
c routine on your problem is to change the array dimensions
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-complex.doc in DOCUMENTS directory.
c This codes implements
c
c
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
c\BeginLib
c
c\Routines called
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 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nsimp.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
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
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
Complex*16
& sigma
Double precision
& tol
logical rvec
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zaxpy , dlapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting mcaupd = 1 |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
mcaitr = 0
mcapps = 0
mcaupd = 1
mcaup2 = 0
mceigh = 0
mceupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
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 | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c | |
c %-----------------------------------------------%
c
nev = 4
ncv = 20
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _NSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling ZNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 | |
c | It MUST initially be set to 0 before the first |
c | call to ZNAUPD . |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | ZNAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse Communication Loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | |
c | y <--- A*x |
c | |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector x , and returns the resulting |
c | matrix-vector product y = A*x in the |
c | array workd(ipntr(2)). |
c %-------------------------------------------%
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 %-----------------------------------------%
c
go to 10
c
endif
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
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 | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1.) |
c | |
c %-------------------------------------------%
c
rvec = .true.
c
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)
c
c %-----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D and the corresponding |
c | eigenvectors are returned in the first |
c | NCONV (=IPARAM(5)) columns of the two |
c | dimensional array V if requested. Otherwise, |
c | an orthogonal basis for the invariant |
c | subspace corresponding to the eigenvalues in |
c | D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
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))
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and relative residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NSIMP '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program znsimp . |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
subroutine av (nx, v, w)
integer nx, j, lo
Complex*16
& v(nx*nx), w(nx*nx), one, h2
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
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2-dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx)
c on the unit squqre with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c
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)
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)
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)
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex*16
& x(nx), y(nx), h, h2, dd, dl, du
c
Complex*16
& one, rho
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)
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
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/README 0000644 0001750 0001750 00000010623 12277373057 012421 0000000 0000000 1. Purpose
-------
This directory contains example drivers that call ARPACK subroutines
__aupd.f and __eupd.f to solve various eigenvalue problems using regular,
shift-invert or other special modes (such as Cayley, Bucking etc.)
These drivers illustrate how to set various ARPACK parameters to solve
different problems in different modes. They provide a guideline on how
to use ARPACK's reverse communication interface. The user may modify
any one of these drivers, and supply his/her own matrix vector
multiplication routine to solve the problem of his/her own interest.
These drivers are installed in the following subdirectories.
SIMPLE --- simple drivers for beginners.
SYM --- drivers for symmetric eigenvalue problems
NONSYM --- drivers for nonsymmetric eigenvalue problems
COMPLEX --- drivers for eigenvalue problem with complex matrices
BAND --- drivers for eigenvalue problem with BANDED matrices
SVD --- drivers for computing singular values and vectors
of a m by n matrix.
2. Getting started
---------------
If you have never used ARPACK before, it might be a good idea
to go into the subdirectory SIMPLE, and read one of the
simple drivers [s,d]ssimp.f, [s,d]nsimp.f [c,z]nsimp.f
first. The documentation explains how to use ARPACK in
considerable detail. To run these drivers, you may use the
makefile in that directory and issue, for example,
"make sssimp", and then execute using "sssimp"
The output should look like:
_saupd: number of update iterations taken
-----------------------------------------
1 - 1: 5
_saupd: number of "converged" Ritz values
-----------------------------------------
1 - 1: 4
_saupd: final Ritz values
-------------------------
1 - 4: 8.912E+02 9.198E+02 9.198E+02 9.484E+02
_saupd: corresponding error bounds
----------------------------------
1 - 4: 4.686E-11 1.905E-08 1.050E-10 5.700E-19
==========================================
= Symmetric implicit Arnoldi update code =
= Version Number: 2.1 =
= Version Date: 11/15/95 =
==========================================
= Summary of timing statistics =
==========================================
Total number update iterations = 5
Total number of OP*x operations = 78
Total number of B*x operations = 0
Total number of reorthogonalization steps = 78
Total number of iterative refinement steps = 0
Total number of restart steps = 0
Total time in user OP*x operation = 0.066667
Total time in user B*x operation = 0.000000
Total time in Arnoldi update routine = 1.166667
Total time in ssaup2 routine = 1.166667
Total time in basic Arnoldi iteration loop = 0.216667
Total time in reorthogonalization phase = 0.066667
Total time in (re)start vector generation = 0.000000
Total time in trid eigenvalue subproblem = 0.050000
Total time in getting the shifts = 0.000000
Total time in applying the shifts = 0.900000
Total time in convergence testing = 0.000000
Ritz values and relative residuals
----------------------------------
Col 1 Col 2
Row 1: 8.91167E+02 6.95597E-07
Row 2: 9.19781E+02 3.30156E-07
Row 3: 9.19781E+02 4.25717E-07
Row 4: 9.48395E+02 3.20519E-07
_SSIMP
======
Size of the matrix is 100
The number of Ritz values requested is 4
The number of Arnoldi vectors generated (NCV) is 20
What portion of the spectrum: LM
The number of converged Ritz values is 4
The number of Implicit Arnoldi update iterations taken is 5
The number of OP*x is 78
The convergence criterion is 5.96046E-08
3. Convention
----------
The naming convention for each driver is explained in
the README file in each subdirectory.
4. LAPACK & BLAS routines
----------------------
All ARPACK codes assume the use of LAPACK version 2.0 codes.
LAPACK and BLAS routines needed for each driver program are
listed at the beginning of the documentation in each driver
program.
arpack-ng-3.1.5/EXAMPLES/Makefile.am 0000644 0001750 0001750 00000000062 12277666406 013574 0000000 0000000 SUBDIRS = BAND COMPLEX NONSYM SIMPLE SVD SYM
arpack-ng-3.1.5/EXAMPLES/BAND/ 0000755 0001750 0001750 00000000000 12277671461 012323 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr4.f 0000644 0001750 0001750 00000023432 12277373057 013600 0000000 0000000 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 closest to SIGMA such that
c A*x = LAMBDA*M*x.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr4.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Double precision
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2 , dnrm2
external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | (closest to the shift SIGMA) to be approximated. |
c | Since the shift and invert mode is used, WHICH |
c | is set to 'LM'. The user can modify N, NEV, NCV |
c | and SIGMA to solve problems of different sizes, |
c | and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR4 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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,
& 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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr1.f 0000644 0001750 0001750 00000027467 12277373057 013604 0000000 0000000 program dnbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
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 A*x = LAMBDA*x.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h, h2, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
rho = 1.0D+2
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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,
& workev, n, a, m, lda, rfac, cfac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam, workd,
& workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR1 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr5.f 0000644 0001750 0001750 00000027767 12277373057 013613 0000000 0000000 program dnbdr5
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
c diagonal block is a tridiagonal matrix with
c 4 on the diagonal, 1-rho*h/2 on the subdiagonal and
c 1+rho*h/2 on the superdiagonal. Each off-diagonal block
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 such that
c A*x = LAMBDA*x.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the size of each block diagonal |
c | of A. The number N(=NX*NX) is the dimension of |
c | the matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to (SIGMAR,SIGMAI)) to be |
c | approximated. Since the shift-invert moded is |
c | used, WHICH is set to 'LM'. The user can modify |
c | NX, NEV, NCV, SIGMAR, SIGMAI to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 4.0D-1
sigmai = 6.0D-1
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0D+0
m(idiag,j) = 4.0D+0
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+kl+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
a(isup,j+1) = -one+h*rho/two
a(isub,j) = -one-h*rho/two
40 continue
50 continue
c
do 60 j = 1, n-1
m(isup,j+1) = one
m(isub,j) = one
60 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one
a(isub,j) = -one
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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, workev, n, a, m, lda, rfac, cfac, ku, kl,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR5 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr6.f 0000644 0001750 0001750 00000023344 12277373057 013623 0000000 0000000 program ssbdr6
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 SSBAND with Cayley mode to find eigenvalues LAMBDA such that
c A*x = LAMBDA*M*x.
c
c ... Use mode 5 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Real
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. Since the Cayley mode is |
c | used, WHICH is set to 'LM'. The user can |
c | modify N, NEV, NCV and SIGMA to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 150.0
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 5 of SSAUPD is used |
c | (IPARAM(7) = 5). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 5
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR6 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssband.f 0000644 0001750 0001750 00000076676 12277373057 013712 0000000 0000000 c \BeginDoc
c
c \Name: ssband
c
c \Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal (Lanczos) basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style band form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
c of n*nev if both are requested (in this case a separate array Z must be
c supplied).
c
c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
c are called Ritz values and Ritz vectors respectively. They are referred
c to as such in the comments that follow. The computed orthonormal basis
c for the invariant subspace corresponding to these Ritz values is referred
c to as a Lanczos basis.
c
c ssband can be called with one of the following modes:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 in SSAUPD)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c The choice of mode must be specified in IPARAM(7) defined below.
c
c \Usage
c call ssband
c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, N, AB, MB, LDA,
c RFAC, KL, KU, WHICH, BMAT, NEV, TOL, RESID, NCV, V,
c LDV, IPARAM, WORKD, WORKL, LWORKL, IWORK, INFO )
c
c \Arguments
c
c RVEC Logical (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the associated Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
c = 'A': compute all Ritz vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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
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
c the Ritz values of OP computed by ssaupd 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 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.
c
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 Lanczos basis array V computed by SSAUPD.
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 Real (INPUT)
c If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
c IPARAM(7) = 1 or 2.
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c AB Real 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 Real 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
c array AB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7) = 1
c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, RFAC.
c
c RFAC Real array of LDA by N. (WORKSPACE/OUTPUT)
c RFAC is used to store the LU factors of MB when IPARAM(7) = 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when IPARAM(7) = 3,4,5 is invoked.
c It is not referenced when IPARAM(7) = 1.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When IPARAM(7)= 1 or 2, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LA' -> want the NEV eigenvalues of largest REAL part.
c 'SA' -> want the NEV eigenvalues of smallest REAL part.
c 'BE' -> Compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from
c the high end than from the low end.
c
c When IPARAM(7) = 3, 4, or 5, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed.
c
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c Represents the dimension of the Lanczos basis constructed
c by ssaupd for OP.
c
c V Real array N by NCV. (OUTPUT)
c Upon INPUT: the NCV columns of V contain the Lanczos basis
c vectors as constructed by ssaupd for OP.
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c represent the Ritz vectors that span the desired
c invariant subspace.
c NOTE: The array Z may be set equal to first NEV columns of the
c Lanczos basis vector array V computed by ssaupd. In this case
c if RVEC=.TRUE., the first NCONV=IPARAM(5) columns of V contain
c the desired Ritz vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ------------------------------------------------------------
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 ssband for the
c five modes available.
c
c IPARAM(8) = NP
c Not referenced.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c WORKD Real work array of length at least 3*n. (WORKSPACE)
c
c WORKL Real work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used when IPARAM(7)=2,3,4,5 to store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
c is to increase the size of NCV relative to NEV.
c See remark 4 in SSAUPD.
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 = -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 trid. eigenvalue calculation;
c Informational error from LAPACK routine ssteqr.
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 = -13: HOWMNY must be one of 'A' or 'P'
c = -14: SSAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current
c Arnoldi factorization.
c
c \EndDoc
c
c------------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgbtrf LAPACK band matrix factorization routine.
c sgbtrs LAPACK band linear system solve routine.
c slacpy LAPACK matrix copy routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c---------------------------------------------------------------------
c
subroutine ssband( rvec, howmny, select, d, z, ldz, sigma,
& n, ab, mb, lda, rfac, kl, ku, which, bmat, nev,
& tol, resid, ncv, v, ldv, iparam, workd, workl,
& lworkl, iwork, info)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character which*2, bmat, howmny
integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Real
& tol, sigma
logical rvec
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(*), iwork(*)
logical select(*)
Real
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), rfac(lda,*),
& workd(*), workl(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, type, imid, itop, ibot, ierr
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
Real
& sdot, snrm2, slapy2
external sdot, scopy, sgbmv, sgbtrf,
& sgbtrs, snrm2, slapy2, slacpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------------------%
c | Set type of the problem to be solved. Check consistency |
c | between BMAT and IPARAM(7). |
c | type = 1 --> Solving standard problem in regular mode. |
c | type = 2 --> Solving standard problem in shift-invert mode. |
c | type = 3 --> Solving generalized problem in regular mode. |
c | type = 4 --> Solving generalized problem in shift-invert mode. |
c | type = 5 --> Solving generalized problem in Buckling mode. |
c | type = 6 --> Solving generalized problem in Cayley mode. |
c %----------------------------------------------------------------%
c
if ( iparam(7) .eq. 1 ) then
type = 1
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'I') then
type = 2
else if ( iparam(7) .eq. 2 ) then
type = 3
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'G') then
type = 4
else if ( iparam(7) .eq. 4 ) then
type = 5
else if ( iparam(7) .eq. 5 ) then
type = 6
else
print*, ' '
print*, 'BMAT is inconsistent with IPARAM(7).'
print*, ' '
go to 9000
end if
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( type .eq. 2 .or. type .eq. 6 .and. bmat .eq. 'I' ) then
c
c %----------------------------------%
c | Solving a standard eigenvalue |
c | problem in shift-invert or |
c | Cayley mode. Factor (A-sigma*I). |
c %----------------------------------%
c
call slacpy ('A', ibot, n, ab, lda, rfac, lda )
do 10 j = 1, n
rfac(imid,j) = ab(imid,j) - sigma
10 continue
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr )
if (ierr .ne. 0) then
print*, ' '
print*, ' _SBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %----------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | regular mode. Copy M to rfac and Call LAPACK |
c | routine sgbtrf to factor M. |
c %----------------------------------------------%
c
call slacpy ('A', ibot, n, mb, lda, rfac, lda )
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_SBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 .or. type .eq. 5 .or. type .eq. 6
& .and. bmat .eq. 'G' ) then
c
c %-------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | shift-invert, Buckling, or Cayley mode. |
c %-------------------------------------------%
c
c %-------------------------------------%
c | Construct and factor (A - sigma*M). |
c %-------------------------------------%
c
do 60 j = 1,n
do 50 i = itop, ibot
rfac(i,j) = ab(i,j) - sigma*mb(i,j)
50 continue
60 continue
c
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_SBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
90 continue
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2 ) then
c
c %----------------------------------%
c | Perform |
c | y <--- OP*x = inv[A-sigma*I]*x |
c | to force the starting vector |
c | into the range of OP. |
c %----------------------------------%
c
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _bgtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | to force the starting vector into |
c | the range of OP. |
c %-----------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call scopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*M |
c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 5) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*A |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call sgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 6 ) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = (inv[A-SIGMA*M])*(A+SIGMA*M)*x |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
if ( bmat .eq. 'G' ) then
call sgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
call sgbmv('Notranspose', n, n, kl, ku, sigma,
& mb(itop,1), lda, workd(ipntr(1)), 1,
& one, workd(ipntr(2)), 1)
else
call scopy(n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, sigma,
& workd(ipntr(2)), 1)
end if
c
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
else if (ido .eq. 1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2) then
c
c %----------------------------------%
c | Perform |
c | y <--- OP*x = inv[A-sigma*I]*x. |
c %----------------------------------%
c
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call scopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %-------------------------------------%
c
call scopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 5 ) then
c
c %-------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*A*x |
c | B*x = A*x has been computed |
c | and saved in workd(ipntr(3)). |
c %-------------------------------%
c
call scopy (n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 6) then
c
c %---------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*(A+SIGMA*M)*x. |
c | (M*x) has been saved in |
c | workd(ipntr(3)). |
c %---------------------------------%
c
if ( bmat .eq. 'G' ) then
call sgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
call saxpy( n, sigma, workd(ipntr(3)), 1,
& workd(ipntr(2)), 1 )
else
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, sigma,
& workd(ipntr(2)), 1)
end if
call sgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
end if
c
else if (ido .eq. 2) then
c
c %----------------------------------%
c | Perform y <-- B*x |
c | Note when Buckling mode is used, |
c | B = A, otherwise B=M. |
c %----------------------------------%
c
if (type .eq. 5) then
c
c %---------------------%
c | Buckling Mode, B=A. |
c %---------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
else
call sgbmv('Notranspose', n, n, kl, ku, one,
& mb(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
end if
c
else
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-----------------------------------------%
c
if ( info .lt. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
go to 9000
c
else
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
if (iparam(5) .gt. 0) then
c
call sseupd ( rvec, 'A', select, d, z, ldz, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of sneupd. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
go to 9000
c
end if
c
end if
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %----------------------------------------%
c
go to 90
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/BAND/cnbdr4.f 0000644 0001750 0001750 00000024511 12277373057 013571 0000000 0000000 program cndrv4
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matries A and M are derived from the finite
c element discretization of the 1-dimensional
c convection-diffusion operator
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 CNBAND to find eigenvalues LAMBDA such that
c A*x = M*x*LAMBDA.
c
c ... Use mode 3 of CNAUPD.
c
c\BeginLib
c
c\Routines called:
c cnband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c claset LAPACK routine to initialize a matrix to zero.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c cgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j,
& n, idiag, isup, isub, maxitr, mode,
& nconv
logical rvec
Real
& tol
Complex
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
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
& scnrm2, slapy2
external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV is the number of |
c | eigenvalues (closest to the shift SIGMA) to be |
c | approximated. Since the shift and invert mode |
c | is used, WHICH is set to 'LM'. The user can |
c | modify NX, NEV and NCV to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = (1.0E+1, 0.0E+0)
c
c %----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 |
c | precision is used. Setting INFO=0 indicates that |
c | we using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
info = 0
tol = 0.0
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of CNAUPD is used |
c | (IPARAm(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
c | in cnband. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / cmplx(n+1)
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = four * h / six
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
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 / six
m(isub,j) = one*h / six
40 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
call cnband(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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR4 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
do 90 j = 1, nconv
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call cgbmv('Notranspose', n, n, kl, ku, one,
& 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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1), rd(j,2))
90 continue
call smout(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 cnband. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr3.f 0000644 0001750 0001750 00000027602 12277373057 013614 0000000 0000000 program snbdr3
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A and M are derived from the finite element
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 SNBAND 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 SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 ,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 |
c | precision is used. The number IDO is used for |
c | reverse communication and has to be set to 0 at |
c | the beginning. Setting INFO=0 indicates that we |
c | using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
info = 0
tol = zero
ido = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 2 of SNAUPD is used |
c | (IPARAM(7) = 2). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SNBAND. |
c %---------------------------------------------------%
c
mode = 2
maxitr = 300
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0E+1
do 50 j = 1, n
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
50 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband( 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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR3 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
call smout(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 SNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr4.f 0000644 0001750 0001750 00000023314 12277373057 013616 0000000 0000000 program ssbdr4
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 SSBAND 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 SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr4.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Real
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | (closest to the shift SIGMA) to be approximated. |
c | Since the shift and invert mode is used, WHICH |
c | is set to 'LM'. The user can modify N, NEV, NCV |
c | and SIGMA to solve problems of different sizes, |
c | and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of SSAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SSBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR4 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr2.f 0000644 0001750 0001750 00000030032 12277373057 013563 0000000 0000000 program dnbdr2
c
c ... Construct matrices A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
c
c on the unit square with zero Dirichlet boundary condition
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 such that
c A*x = LAMBDA*x.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c---------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isub, isup, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h2, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to (SIGMAR,SIGMAI)) to be |
c | approximated. Since the shift-invert moded is |
c | used, WHICH is set to 'LM'. The user can modify |
c | NX, NEV, NCV, SIGMAR, SIGMAI to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 1.0D+4
sigmai = 0.0D+0
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0D+1
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isub,j+1) = -one/h2 + rho/two/h
a(isup,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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, workev, n, a, m, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR2 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr4.f 0000644 0001750 0001750 00000027644 12277373057 013623 0000000 0000000 program snbdr4
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A and M are derived from the finite element
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
c ... Define the shift SIGMA = (SIGMAR, SIGMAI).
c
c ... Call SNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*M*x.
c
c ... Use mode 3 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr4.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two, six
parameter (one = 1.0E+0, zero = 0.0E+0,
& two = 2.0E+0, six = 6.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 1.0E+1
sigmai = 0.0E+0
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
info = 0
tol = zero
ido = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of snaupd is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
c | in snaupd. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = n
iparam(7) = 3
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / real(n+1)
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 2.0E+0 / h
m(idiag,j) = 4.0E+0 * h / six
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0E+1
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/six
m(isub,j) = one*h/six
40 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband(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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR4 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 50 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
50 continue
call smout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relatve residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
c | for SNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dnband.f 0000644 0001750 0001750 00000145471 12277373057 013654 0000000 0000000 c \BeginDoc
c
c \Name: dnband
c
c \Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style banded form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
c
c The 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 dnband can be called with one of the following modes:
c
c Mode 1: A*z = lambda*z.
c ===> OP = A and B = I.
c
c Mode 2: A*z = lambda*M*z, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c
c Mode 3: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*z = amu*z, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*z = amu*z, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c
c The choice of mode must be specified in IPARAM(7) defined below.
c
c \Usage
c call dnband
c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, V, N, AB, MB, LDA, RFAC, CFAC, KL, KU, WHICH,
c BMAT, NEV, TOL, RESID, NCV, V, LDV, IPARAM, WORKD,
c WORKL, LWORKL, WORKC, IWORK, INFO )
c
c \Arguments
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 On exit, DR contains the real part of the Ritz value approximations
c to the eigenvalues of A*z = lambda*B*z.
c
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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 On exit,
c 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
c A*z = lambda*B*z computed by DNAUPD.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 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 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 If IPARAM(7) = 3 or 4, represents the imaginary part of the
c shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
c WORKEV Double precision work array of dimension 3*NCV. (WORKSPACE)
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c AB Double precision 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 Double precision 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
c array AB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7) = 1
c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, RFAC and CFAC.
c
c RFAC Double precision array of LDA by N. (WORKSPACE/OUTPUT)
c RFAC is used to store the LU factors of MB when IPARAM(7) = 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when IPARAM(7) = 3 is invoked with a real shift.
c It is not referenced when IPARAM(7) = 1 or 4.
c
c CFAC Complex*16 array of LDA by N. (WORKSPACE/OUTPUT)
c CFAC is used to store (A-SIGMA*M) and its LU factors
c when IPARAM(7) = 3 or 4 are used with a complex shift SIGMA.
c On exit, it contains the LU factors of (A-SIGMA*M).
c It is not referenced when IPARAM(7) = 1 or 2.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When IPARAM(7)= 1 or 2, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 When IPARAM(7) = 3 or 4, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*z = lambda*z
c BMAT = 'G' -> generalized eigenvalue problem A*z = lambda*M*z
c NEV Integer. (INPUT)
c Number of eigenvalues to be computed.
c
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 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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c Represents the dimension of the Arnoldi basis constructed
c by dnaupd for OP.
c
c V Double precision array N by NCV+1. (OUTPUT)
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c represent approximate Schur vectors that span the
c desired invariant subspace.
c NOTE: The array Z may be set equal to first NEV+1 columns of the
c Arnoldi basis vector array V computed by DNAUPD. In this case
c if RVEC = .TRUE. and HOWMNY='A', then the first NCONV=IPARAM(5)
c are the desired Ritz vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ----------------------------------------------------------
c ISHIFT = 1: exact shift with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c
c IPARAM(6) = IUPD
c Not referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = IPARAM(7):
c On INPUT determines what type of eigenproblem is being solved.
c Must be 1,2,3,4; See under \Description of dnband for the
c four modes available.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*z operations,
c NUMOPB = total number of B*z operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c WORKD Double precision work array of length at least 3*n. (WORKSPACE)
c
c WORKL Double precision work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c WORKC Complex*16 array of length N. (WORKSPACE)
c Workspace used when IPARAM(7) = 3 or 4 for storing a temporary
c complex vector.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used when IPARAM(7)=2,3,4 to store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
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 NCV and allocate at least NCV
c columns for Z. NOTE: Not necessary if Z and V share
c the same space. Please notify the authors.
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 = -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 = -9: Error return from calculation of eigenvectors.
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'
c = -14: DNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: Overflow occurs when we try to transform the Ritz
c values returned from DNAUPD to those of the original
c problem using Rayleigh Quotient.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current
c Arnoldi factorization.
c
c \EndDoc
c
c------------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dgbtrf LAPACK band matrix factorization routine.
c dgbtrs LAPACK band linear system solve routine.
c zgbtrf LAPACK complex band matrix factorization routine.
c zgbtrs LAPACK complex linear system solve routine.
c dlacpy LAPACK matrix copy routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dlamch LAPACK routine to compute the underflow threshold.
c dcopy Level 1 BLAS that copies one vector to another.
c ddot Level 1 BLAS that computes the dot product of two vectors.
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\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
c Ritz values are stored on the diagonal of T.
c
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c---------------------------------------------------------------------
c
subroutine dnband( rvec, howmny, select, dr, di, z, ldz, sigmar,
& sigmai, workev, n, ab, mb, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv,
& iparam, workd, workl, lworkl, workc, iwork, info)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character which*2, bmat, howmny
integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Double precision
& tol, sigmar, sigmai
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(*), iwork(*)
logical select(*)
Double precision
& dr(*), di(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), rfac(lda,*),
& workd(*), workl(*), workev(*)
Complex*16
& cfac(lda,*), workc(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, type, imid, itop, ibot, ierr
Double precision
& numr, denr, deni, dmdul, safmin
logical rvec, first
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
Double precision
& ddot, dnrm2, dlapy2, dlamch
external ddot, dcopy, dgbmv, zgbtrf, zgbtrs, dgbtrf,
& dgbtrs, dnrm2, dlapy2, dlacpy, dlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
Intrinsic dble, dimag, dcmplx
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = dlamch('safmin')
c
c %----------------------------------------------------------------%
c | Set type of the problem to be solved. Check consistency |
c | between BMAT and IPARAM(7). |
c | type = 1 --> Solving standard problem in regular mode. |
c | type = 2 --> Solving standard problem in shift-invert mode. |
c | type = 3 --> Solving generalized problem in regular mode. |
c | type = 4 --> Solving generalized problem in shift-invert mode. |
c | type = 5 --> Solving standard problem in shift-invert mode |
c | using iparam(7) = 4 in DNAUPD. |
c | type = 6 --> Solving generalized problem in shift-invert mode. |
c | using iparam(7) = 4 in DNAUPD. |
c %----------------------------------------------------------------%
c
if ( iparam(7) .eq. 1 ) then
type = 1
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'I') then
type = 2
else if ( iparam(7) .eq. 2 ) then
type = 3
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'G') then
type = 4
else if ( iparam(7) .eq. 4 .and. bmat .eq. 'I') then
type = 5
else if ( iparam(7) .eq. 4 .and. bmat .eq. 'G') then
type = 6
else
print*, ' '
print*, 'BMAT is inconsistent with IPARAM(7).'
print*, ' '
go to 9000
end if
c
c %----------------------------------%
c | When type = 5,6 are used, sigmai |
c | must be nonzero. |
c %----------------------------------%
c
if ( type .eq. 5 .or. type .eq. 6 ) then
if ( sigmai .eq. zero ) then
print*, ' '
print*, '_NBAND: sigmai must be nonzero when type 5 or 6
& is used. '
print*, ' '
go to 9000
end if
end if
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( type .eq. 2 .or. type .eq. 5 ) then
c
c %-------------------------------%
c | Solving a standard eigenvalue |
c | problem in shift-invert mode. |
c | Factor (A-sigma*I). |
c %-------------------------------%
c
if (sigmai .eq. zero) then
c
c %-----------------------------------%
c | Construct (A-sigmar*I) and factor |
c | in real arithmetic. |
c %-----------------------------------%
c
call dlacpy ('A', ibot, n, ab, lda, rfac, lda )
do 10 j = 1, n
rfac(imid,j) = ab(imid,j) - sigmar
10 continue
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr )
if (ierr .ne. 0) then
print*, ' '
print*, ' _NBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
else
c
c %-----------------------------------%
c | Construct (A-sigmar*I) and factor |
c | in COMPLEX arithmetic. |
c %-----------------------------------%
c
do 30 j = 1, n
do 20 i = itop, ibot
cfac(i,j) = dcmplx(ab(i,j))
20 continue
30 continue
c
do 40 j = 1, n
cfac(imid,j) = cfac(imid,j)
$ - dcmplx(sigmar, sigmai)
40 continue
c
call zgbtrf(n, n, kl, ku, cfac, lda, iwork, ierr )
if ( ierr .ne. 0) then
print*, ' '
print*, ' _NBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
end if
else if ( type .eq. 3 ) then
c
c %-----------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | regular mode. Copy M to rfac, and call LAPACK |
c | routine dgbtrf to factor M. |
c %-----------------------------------------------%
c
call dlacpy ('A', ibot, n, mb, lda, rfac, lda )
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 .or. type .eq. 6 ) then
c
c %-------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | shift-invert mode. |
c %-------------------------------------------%
c
if ( sigmai .eq. zero ) then
c
c %--------------------------------------------%
c | Construct (A - sigma*M) and factor in real |
c | arithmetic. |
c %--------------------------------------------%
c
do 60 j = 1,n
do 50 i = itop, ibot
rfac(i,j) = ab(i,j) - sigmar*mb(i,j)
50 continue
60 continue
c
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else
c
c %-----------------------------------------------%
c | Construct (A - sigma*M) and factor in complex |
c | arithmetic. |
c %-----------------------------------------------%
c
do 80 j = 1,n
do 70 i = itop, ibot
cfac(i,j) = dcmplx( ab(i,j)-sigmar*mb(i,j),
& -sigmai*mb(i,j) )
70 continue
80 continue
c
call zgbtrf(n, n, kl, ku, cfac, lda, iwork, ierr)
if ( ierr .NE. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
90 continue
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2 ) then
c
if (sigmai .eq. zero) then
c
c %----------------------------------%
c | Shift is real. Perform |
c | y <--- OP*x = inv[A-sigmar*I]*x |
c | to force the starting vector |
c | into the range of OP. |
c %----------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _bgtrs. '
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------------------------%
c | Shift is COMPLEX. Perform |
c | y <--- OP*x = Real_Part{inv[A-sigma*I]*x} |
c | to force the starting vector into the |
c | range of OP. |
c %--------------------------------------------%
c
do 100 j = 1, n
workc(j) = dcmplx(workd(ipntr(1)+j-1))
100 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 110 j = 1, n
workd(ipntr(2)+j-1) = dble(workc(j))
110 continue
c
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | to force the starting vector into |
c | the range of OP. |
c %-----------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = Real_part{inv[A-SIGMA*M]*M}*x |
c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
if ( sigmai .eq. zero ) then
c
c %---------------------%
c | Shift is real, stay |
c | in real arithmetic. |
c %---------------------%
c
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------%
c | Goto complex arithmetic. |
c %--------------------------%
c
do 120 i = 1,n
workc(i) = dcmplx(workd(ipntr(2)+i-1))
120 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 130 i = 1, n
workd(ipntr(2)+i-1) = dble(workc(i))
130 continue
c
end if
c
else if ( type .eq. 5) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*I]}*x |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
do 140 j = 1, n
workc(j) = dcmplx(workd(ipntr(1)+j-1))
140 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 150 j = 1, n
workd(ipntr(2)+j-1) = dimag(workc(j))
150 continue
c
else if ( type .eq. 6 ) then
c
c %----------------------------------------%
c | Perform y <-- OP*x |
c | Imaginary_part{inv[A-SIGMA*M]*M} |
c | to force the starting vector into the |
c | range of OP. |
c %----------------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
do 160 i = 1,n
workc(i) = dcmplx(workd(ipntr(2)+i-1))
160 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 170 i = 1, n
workd(ipntr(2)+i-1) = dimag(workc(i))
170 continue
c
end if
c
else if (ido .eq. 1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2) then
c
if ( sigmai .eq. zero) then
c
c %----------------------------------%
c | Shift is real. Perform |
c | y <--- OP*x = inv[A-sigmar*I]*x. |
c %----------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
else
c
c %------------------------------------------%
c | Shift is COMPLEX. Perform |
c | y <-- OP*x = Real_Part{inv[A-sigma*I]*x} |
c | in COMPLEX arithmetic. |
c %------------------------------------------%
c
do 180 j = 1, n
workc(j) = dcmplx(workd(ipntr(1)+j-1))
180 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 190 j = 1, n
workd(ipntr(2)+j-1) = dble(workc(j))
190 continue
c
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %--------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %--------------------------------------%
c
if ( sigmai .eq. zero ) then
c
c %------------------------%
c | Shift is real, stay in |
c | real arithmetic. |
c %------------------------%
c
call dcopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %---------------------------%
c | Go to COMPLEX arithmetic. |
c %---------------------------%
c
do 200 i = 1,n
workc(i) = dcmplx(workd(ipntr(3)+i-1))
200 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error in _gbtrs.'
print*, ' '
go to 9000
end if
c
do 210 i = 1,n
workd(ipntr(2)+i-1) = dble(workc(i))
210 continue
c
end if
c
else if ( type .eq. 5 ) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*I]*x} |
c %---------------------------------------%
c
do 220 j = 1, n
workc(j) = dcmplx(workd(ipntr(1)+j-1))
220 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 230 j = 1, n
workd(ipntr(2)+j-1) = dimag(workc(j))
230 continue
c
else if ( type .eq. 6) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*M]*M}*x. |
c %-----------------------------------------%
c
do 240 i = 1,n
workc(i) = dcmplx(workd(ipntr(3)+i-1))
240 continue
c
call zgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 250 i = 1, n
workd(ipntr(2)+i-1) = dimag(workc(i))
250 continue
c
end if
c
else if (ido .eq. 2) then
c
c %--------------------%
c | Perform y <-- M*x |
c | Not used when |
c | type = 1,2. |
c %--------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-----------------------------------------%
c
if ( info .lt. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd '
print *, ' '
go to 9000
c
else
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
if (iparam(5) .gt. 0) then
c
call dneupd ( rvec, 'A', select, dr, di, z, ldz,
& sigmar, sigmai, workev, bmat, n, which,
& nev, tol, resid, ncv, v, ldv, iparam,
& ipntr, workd, workl, lworkl, info )
c
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
go to 9000
c
else if ( sigmai .ne. zero ) then
c
if ( type .eq. 4 .or. type .eq. 6 ) then
c
first = .true.
do 270 j = 1, iparam(5)
c
c %----------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original |
c | generalized eigenvalue problem. |
c %----------------------------------%
c
if ( di(j) .eq. zero ) then
c
c %--------------------------------------%
c | Eigenvalue is real. Compute |
c | d = (x'*inv[A-sigma*M]*M*x) / (x'*x) |
c %--------------------------------------%
c
call dgbmv('Nontranspose', n, n, kl, ku, one,
$ mb(itop,1), lda, z(1,j), 1, zero,
$ workd, 1)
do i = 1, n
workc(i) = dcmplx(workd(i))
end do
call zgbtrs ('Notranspose', n, kl, ku, 1,
$ cfac, lda, iwork, workc, n, info)
do i = 1, n
workd(i) = dble(workc(i))
workd(i+n) = dimag(workc(i))
end do
denr = ddot(n, z(1,j), 1, workd, 1)
deni = ddot(n, z(1,j), 1, workd(n+1), 1)
numr = dnrm2(n, z(1,j), 1)**2
dmdul = dlapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar + numr*denr / dmdul
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
end if
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %-------------%
c | Compute M*x |
c %-------------%
c
call dgbmv('Nontranspose', n, n, kl, ku,
$ one, mb(itop,1), lda, z(1,j), 1, zero,
$ workd, 1)
call dgbmv('Nontranspose', n, n, kl, ku,
$ one, mb(itop,1), lda, z(1,j+1), 1,
$ zero, workd(n+1), 1)
do i = 1, n
workc(i) = dcmplx(workd(i),workd(i+n))
end do
c
c %----------------------------%
c | Compute inv(A-sigma*M)*M*x |
c %----------------------------%
c
call zgbtrs('Notranspose',n,kl,ku,1,cfac,
$ lda, iwork, workc, n, info)
c
c %-------------------------------%
c | Compute x'*inv(A-sigma*M)*M*x |
c %-------------------------------%
c
do i = 1, n
workd(i) = dble(workc(i))
workd(i+n) = dimag(workc(i))
end do
denr = ddot(n,z(1,j),1,workd,1)
denr = denr+ddot(n,z(1,j+1),1,workd(n+1),1)
deni = ddot(n,z(1,j),1,workd(n+1),1)
deni = deni - ddot(n,z(1,j+1),1,workd,1)
c
c %----------------%
c | Compute (x'*x) |
c %----------------%
c
numr = dlapy2( dnrm2(n, z(1,j), 1),
& dnrm2(n, z(1, j+1), 1) )**2
c
c %----------------------------------------%
c | Compute (x'x) / (x'*inv(A-sigma*M)*Mx) |
c %----------------------------------------%
c
dmdul = dlapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar+numr*denr / dmdul
di(j) = sigmai-numr*deni / dmdul
first = .false.
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
c
end if
c
else
c
c %---------------------------%
c | Get the second eigenvalue |
c | of the conjugate pair by |
c | taking the conjugate of |
c | previous one. |
c %---------------------------%
c
dr(j) = dr(j-1)
di(j) = -di(j-1)
first = .true.
c
end if
c
270 continue
c
else if ( type .eq. 2 .or. type .eq. 5) then
c
first = .true.
do 280 j = 1, iparam(5)
c
c %----------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original |
c | standard eigenvalue problem. |
c %----------------------------------%
c
if ( di(j) .eq. zero ) then
c
c %-------------------------------------%
c | Eigenvalue is real. Compute |
c | d = (x'*inv[A-sigma*I]*x) / (x'*x). |
c %-------------------------------------%
c
do i = 1, n
workc(i) = dcmplx(z(i,j))
end do
call zgbtrs ('Notranspose', n, kl, ku, 1,
$ cfac, lda, iwork, workc, n, info)
do i = 1, n
workd(i) = dble(workc(i))
workd(i+n) = dimag(workc(i))
end do
denr = ddot(n,z(1,j),1,workd,1)
deni = ddot(n,z(1,j),1,workd(n+1),1)
numr = dnrm2(n, z(1,j), 1)**2
dmdul = dlapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar + numr*denr / dmdul
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
c
end if
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
do i = 1, n
workc(i) = dcmplx( z(i,j), z(i,j+1) )
end do
c
c %---------------------------%
c | Compute inv[A-sigma*I]*x. |
c %---------------------------%
c
call zgbtrs('Notranspose',n,kl,ku,1,cfac,
$ lda, iwork, workc, n, info)
c
c %-----------------------------%
c | Compute x'*inv(A-sigma*I)*x |
c %-----------------------------%
c
do i = 1, n
workd(i) = dble(workc(i))
workd(i+n) = dimag(workc(i))
end do
denr = ddot(n,z(1,j),1,workd,1)
denr = denr+ddot(n,z(1,j+1),1,workd(n+1),1)
deni = ddot(n,z(1,j),1,workd(n+1),1)
deni = deni - ddot(n,z(1,j+1),1,workd,1)
c
c %----------------%
c | Compute (x'*x) |
c %----------------%
c
numr = dlapy2( dnrm2(n, z(1,j), 1),
& dnrm2(n, z(1,j+1), 1))**2
c
c %----------------------------------------%
c | Compute (x'x) / (x'*inv(A-sigma*I)*x). |
c %----------------------------------------%
c
dmdul = dlapy2(denr,deni)**2
if (dmdul .ge. safmin) then
dr(j) = sigmar+numr*denr / dmdul
di(j) = sigmai-numr*deni / dmdul
first = .false.
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
end if
c
else
c
c %---------------------------%
c | Get the second eigenvalue |
c | of the conjugate pair by |
c | taking the conjugate of |
c | previous one. |
c %---------------------------%
c
dr(j) = dr(j-1)
di(j) = -di(j-1)
first = .true.
c
end if
c
280 continue
c
end if
c
end if
c
end if
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %----------------------------------------%
c
go to 90
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/BAND/README 0000644 0001750 0001750 00000004574 12277373057 013135 0000000 0000000 1. Purpose
-------
This directory contains example drivers that call subroutines
[s,d]sband.f, [s,d]nband.f or [c,z]nband.f to solve various eigenvalue
problems in which matrices have BANDED structure. These drivers illustrate
how to construct LAPACK-style banded matrices, and how to set various
ARPACK parameters to solve different problems in different modes. The
user may modify any one of these drivers, and construct his/her own matrix
to solve the problem of his/her own interest.
2. Naming convention
-----------------
The name for each banded solver has the form 'XYband.f', where
X - is 's' (single precision)
or 'd' (double precision)
or 'c' (single precision complex)
or 'z' (double precision complex)
Y - is 's' (symmetric)
or 'n' (nonsymmetric)
The name for each driver has the form 'XYbdrN.f', where
X - is 's' (single precision)
or 'd' (double precision)
or 'c' (single precision complex)
or 'z' (double precision complex)
Y - is 's' (symmetric)
or 'n' (nonsymmetric)
N - is a number between 1 and 6. If
N = 1, the driver solves a STANDARD eigenvalue problem in
REGULAR mode.
N = 2, the driver solves a STANDARD eigenvalue problem in
SHIFT-INVERT mode.
N = 3, the driver solves a GENERALIZED eigenvalue problem in
INVERSE mode.
N = 4, the driver solves a GENERALIZED eigenvalue problem in
SHIFT-INVERT mode (using mode 3 of __aupd.)
These are four commonly used drivers.
When N > 4 (only for real matrices), a special mode is used.
For symmetric problem, if
N = 5, the driver solves a GENERALIZED eigenvalue problem in
BUCKLING mode.
N = 6, the driver solves a GENERALIZED eigenvalue problem in
CAYLEY mode.
For nonsymmetric problem, if
N = 5, the driver solves a STANDARD eigenvalue problem in
SHIFT-INVERT mode using mode 4 of [d,s]naupd.f.
N = 6. the driver solves a GENERALIZED eigenvalue problem
SHIFT-INVERT mode using mode 4 of [d,s]naupd.f.
Note: the imaginary part of the shift MUST be nonzero when
these two drivers are used.
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make snbdr1". Then
execute using "snbdr1".
arpack-ng-3.1.5/EXAMPLES/BAND/Makefile.am 0000644 0001750 0001750 00000007163 12277671061 014302 0000000 0000000 check_PROGRAMS = cnbdr1 cnbdr2 cnbdr3 cnbdr4 dnbdr1 dnbdr2 dnbdr3 dnbdr4 dnbdr5 dnbdr6 dsbdr1 dsbdr2 dsbdr3 dsbdr4 dsbdr5 dsbdr6 snbdr1 snbdr2 snbdr3 snbdr4 snbdr5 snbdr6 ssbdr1 ssbdr2 ssbdr3 ssbdr4 ssbdr5 ssbdr6 znbdr1 znbdr2 znbdr3 znbdr4
cnbdr1_SOURCES = cnbdr1.f cnband.f
cnbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr2_SOURCES = cnbdr2.f cnband.f
cnbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr3_SOURCES = cnbdr3.f cnband.f
cnbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr4_SOURCES = cnbdr4.f cnband.f
cnbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr1_SOURCES = dnbdr1.f dnband.f
dnbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr2_SOURCES = dnbdr2.f dnband.f
dnbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr3_SOURCES = dnbdr3.f dnband.f
dnbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr4_SOURCES = dnbdr4.f dnband.f
dnbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr5_SOURCES = dnbdr5.f dnband.f
dnbdr5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr6_SOURCES = dnbdr6.f dnband.f
dnbdr6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr1_SOURCES = dsbdr1.f dsband.f
dsbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr2_SOURCES = dsbdr2.f dsband.f
dsbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr3_SOURCES = dsbdr3.f dsband.f
dsbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr4_SOURCES = dsbdr4.f dsband.f
dsbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr5_SOURCES = dsbdr5.f dsband.f
dsbdr5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr6_SOURCES = dsbdr6.f dsband.f
dsbdr6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snband_SOURCES = snband.f
snband_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr1_SOURCES = snbdr1.f snband.f
snbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr2_SOURCES = snbdr2.f snband.f
snbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr3_SOURCES = snbdr3.f snband.f
snbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr4_SOURCES = snbdr4.f snband.f
snbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr5_SOURCES = snbdr5.f snband.f
snbdr5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr6_SOURCES = snbdr6.f snband.f
snbdr6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr1_SOURCES = ssbdr1.f ssband.f
ssbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr2_SOURCES = ssbdr2.f ssband.f
ssbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr3_SOURCES = ssbdr3.f ssband.f
ssbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr4_SOURCES = ssbdr4.f ssband.f
ssbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr5_SOURCES = ssbdr5.f ssband.f
ssbdr5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr6_SOURCES = ssbdr6.f ssband.f
ssbdr6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr1_SOURCES = znbdr1.f znband.f
znbdr1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr2_SOURCES = znbdr2.f znband.f
znbdr2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr3_SOURCES = znbdr3.f znband.f
znbdr3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr4_SOURCES = znbdr4.f znband.f
znbdr4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = cnbdr1 cnbdr2 cnbdr3 cnbdr4 dnbdr1 dnbdr2 dnbdr3 dnbdr4 dnbdr5 dnbdr6 dsbdr1 dsbdr2 dsbdr3 dsbdr4 dsbdr5 dsbdr6 snbdr1 snbdr2 snbdr3 snbdr4 snbdr5 snbdr6 ssbdr1 ssbdr2 ssbdr3 ssbdr4 ssbdr5 ssbdr6 znbdr1 znbdr2 znbdr3 znbdr4
arpack-ng-3.1.5/EXAMPLES/BAND/cnbdr1.f 0000644 0001750 0001750 00000024763 12277373057 013577 0000000 0000000 program cnbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
c ... Call CNBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
c ... Use mode 1 of CNAUPD.
c
c\BeginLib
c
c cnband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c claset LAPACK routine to initialize a matrix to zero.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c cgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr1.F SID: 2.3 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, i, j,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
Real
& tol
Complex
& rho, h, h2, 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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV and WHICH to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 CNAUPD to start the |
c | Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 1 of CNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details, see the documentation |
c | in cnband. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / cmplx(nx+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
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)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
call cnband(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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR1 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one,
& 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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
90 continue
call smout(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 cnband. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr6.f 0000644 0001750 0001750 00000031474 12277373057 013621 0000000 0000000 program snbdr6
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
c diagonal block is a tridiagonal matrix with
c 4 on the diagonal, 1-rho*h/2 on the subdiagonal and
c 1+rho*h/2 on the superdiagonal. Each subdiagonal block
c of A is an identity matrix. The matrix M is the
c tridiagonal matrix with 4 on the diagonal and 1 on the
c subdiagonal and superdiagonal.
c
c ... Define COMPLEX shift SIGMA=(SIGMAR,SIGMAI), SIGMAI .ne. zero.
c
c ... Call snband to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*M*x.
c
c ... Use mode 4 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c---------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 ,
& two = 2.0E+0 )
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-----------------------------------------------------%
c | The number NX is the size of each diagonal block of |
c | A. The number N(=NX*NX) is the dimension of the |
c | matrix. The number N(=NX*NX) is the dimension of |
c | the matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV numbers of eigenvalues |
c | closest to the COMPLEX shift (SIGMAR,SIGMAI) |
c | (WHICH='LM') and their corresponding eigenvectors |
c | are computed. The user can modify NX, NEV, NCV, |
c | WHICH to solve problems of different sizes, and |
c | to get different parts the spectrum. However, the |
c | following rules must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0E-1
sigmai = 6.0E-1
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 4 of SNAUPD is used |
c | (IPARAm(7) = 4). All these options can be changed |
c | by the user. For details, see the documentation |
c | in snband. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0E+0
m(idiag,j) = 4.0E+0
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+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
a(isub,j+1) = -one+h*rho/two
a(isup,j) = -one-h*rho/two
40 continue
50 continue
c
do 60 j = 1, n-1
m(isub,j+1) = one
m(isup,j) = one
60 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one
a(isub,j) = -one
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband(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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR6 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, d(j,2), mx, 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j+1), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
call smout(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 snband. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/znbdr3.f 0000644 0001750 0001750 00000024411 12277373057 013616 0000000 0000000 program znbdr3
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matrices A and M are derived from the finite
c element discretization of the 1-dimensional
c convection-diffusion operator
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 A*x = M*x*LAMBDA.
c
c ... Eigenvalues with largest real parts are sought.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr3.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j,
& n, idiag, isup, isub, maxitr,
& mode, nconv
logical rvec
Double precision
& tol
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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV and WHICH to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %----------------------------------------------------%
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 |
c | precision is used. Setting INFO=0 indicates that |
c | using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
info = 0
tol = 0.0
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 2
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
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
40 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR3 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
do 50 j = 1, nconv
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
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,
& 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))
50 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr4.f 0000644 0001750 0001750 00000027727 12277373057 013606 0000000 0000000 program dnbdr4
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A and M are derived from the finite element
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
c ... Define the shift SIGMA = (SIGMAR, SIGMAI).
c
c ... Call DNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*M*x.
c
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
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr4.F SID: 2.6 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two, six
parameter (one = 1.0D+0, zero = 0.0D+0,
& two = 2.0D+0, six = 6.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2, dgbmv, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 1.0D+1
sigmai = 0.0D+0
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
info = 0
tol = zero
ido = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 dnaupd. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = n
iparam(7) = 3
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dble(n+1)
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 2.0D+0 / h
m(idiag,j) = 4.0D+0 * h / six
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0D+1
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/six
m(isub,j) = one*h/six
40 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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, workev, n, A, M, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR4 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 50 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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,
& 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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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,
& 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,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& 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,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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
50 continue
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and relatve residuals')
else
c
c %-------------------------------------%
c | Either convergence failed, or there |
c | is error. Check the documentation |
c | for DNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/znbdr2.f 0000644 0001750 0001750 00000025323 12277373057 013620 0000000 0000000 program znbdr2
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
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 A*x = x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr2.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, i, j,
& n, nxi, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
Double precision
& tol
Complex*16
& rho, h, h2, 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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to SIGMA) to be |
c | approximated. Since the shift and invert mode |
c | is used, WHICH is set to 'LM'. The user can |
c | modify NX, NEV and NCV to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nxi = 10
n = nxi*nxi
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
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 | Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nxi
ku = nxi
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
rho = (1.0D+2, 0.0D+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nxi
lo = (i-1)*nxi
do 40 j = lo+1, lo+nxi-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nxi-1
lo = (i-1)*nxi
do 70 j = lo+1, lo+nxi
a(isup,nxi+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR2 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
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))
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr1.f 0000644 0001750 0001750 00000024220 12277373057 013571 0000000 0000000 program dsbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
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 A*x = x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
Double precision
& tol, sigma, h2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian operator on the unit square with zero |
c | Dirichlet boundary condition. The number |
c | N(=NX*NX) is the dimension of the matrix. A |
c | standard eigenvalue problem is solved |
c | (BMAT = 'I'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify NX,NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0D+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one / h2
a(isub,j) = -one / h2
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR1 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr3.f 0000644 0001750 0001750 00000023343 12277373057 013600 0000000 0000000 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 such that
c A*x = LAMBDA*M*x.
c
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\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Double precision
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2 , dnrm2
external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 2
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR3 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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,
& 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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/cnband.f 0000644 0001750 0001750 00000055070 12277373057 013646 0000000 0000000 c \BeginDoc
c
c \Name: cnband
c
c \Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style banded form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
c
c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
c are 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 Schur basis.
c
c cnband can be called with one of the following modes:
c
c Mode 1: A*z = lambda*z.
c ===> OP = A and B = I.
c
c Mode 2: A*z = lambda*M*z, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c
c Mode 3: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = inv[A - sigma*M]*M and B = M.
c ===> shift-and-invert mode.
c
c Choice of different modes can be specified in IPARAM(7) defined below.
c
c \Usage
c call cnband
c ( RVEC, HOWMNY, SELECT, D , Z, LDZ, SIGMA, WORKEV, N, AB,
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
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the invariant subspace to be computed
c corresponding to the converged Ritz values.
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
c computed. To select the real Ritz vector corresponding to a
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 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 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
c A*z = lambda*B*z.
c
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 columns of the
c array V.
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 ) is required.
c In any case, LDZ .ge. 1 is required.
c
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
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
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 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
c array MB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7)=1.
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 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.
c It is not referenced when IPARAM(7)=1.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When mode 1,2 are used, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 When mode 3 is used, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
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 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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then
c the first NCONV=IPARAM(5) columns of V will contain Ritz vectors
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. LDV must be great than or equal to N.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ----------------------------------------------------------
c ISHIFT = 1: exact shift with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c -------------------------------------------------------------
c
c IPARAM(2) = Not referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c
c IPARAM(6) = IUPD
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 cnband for the
c three modes available.
c
c WORKD Complex work array of length at least 3*n. (WORKSPACE)
c
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 Workspace used in cnaupd.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used to mode 2,3. Store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
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: CNAUPD did not find any eigenvalues to sufficient
c accuracy.
c
c \EndDoc
c
c------------------------------------------------------------------------
c
c\BeginLib
c
c\Routines called
c cnaupd ARPACK reverse communication interface routine.
c cneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c cgbtrf LAPACK band matrix factorization routine.
c cgbtrs LAPACK band linear system solve routine.
c clacpy LAPACK matrix copy routine.
c ccopy Level 1 BLAS that copies one vector to another.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c cgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine cnband(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 )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
Character which*2, bmat, howmny
Logical rvec
Integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Complex
& sigma
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Integer iparam(*), iwork(*)
Logical select(*)
Complex
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), fac(lda,*),
& workd(*), workl(*), workev(*)
Real
& rwork(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, mode, ierr, itop, imid, ibot
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
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
& scnrm2
external ccopy, cgbmv, cgbtrf, cgbtrs, scnrm2, clacpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
mode = iparam(7)
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( mode .eq. 2 ) then
c
c %-----------------------------------------------%
c | Copy M to fac and Call LAPACK routine cgbtrf |
c | to factor M. |
c %-----------------------------------------------%
c
call clacpy ('A', ibot, n, mb, lda, fac, lda )
call cgbtrf(n, n, kl, ku, fac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_band: error in _gbtrf'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
if (bmat .eq. 'I') then
c
c %-------------------------%
c | Construct (A - sigma*I) |
c %-------------------------%
c
call clacpy ('A', ibot, n, ab, lda, fac, lda )
do 10 j = 1,n
fac(imid,j) = ab(imid,j) - sigma
10 continue
c
else
c
c %---------------------------%
c | Construct (A - sigma*M) |
c %---------------------------%
c
do 30 j = 1,n
do 20 i = itop, ibot
fac(i,j) = ab(i,j) - sigma*mb(i,j)
20 continue
30 continue
c
end if
c
c %------------------------%
c | Factor (A - sigma*M) |
c %------------------------%
c
call cgbtrf(n, n, kl, ku, fac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_band: error in _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
40 continue
c
call cnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1) then
c
if ( mode .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( mode .eq. 2 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call cgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*M* x
c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call cgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
else if (ido .eq. 1) then
c
if ( mode .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( mode .eq. 2 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call cgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), ldv, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
if ( bmat .eq. 'I' ) then
c
c %----------------------------------%
c | Perform y <-- inv(A-sigma*I)*x. |
c %----------------------------------%
c
call ccopy(n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call cgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %--------------------------------------%
c
call ccopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call cgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
endif
c
else if (ido .eq. 2) then
c
c %--------------------%
c | Perform y <-- M*x |
c %--------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else
c
c %-------------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-------------------------------------------%
c
if ( info .ne. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in dnaupd |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd '
print *, ' '
c
else
c
call 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
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of cneupd. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
c
endif
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call cnaupd again. |
c %----------------------------------------%
c
go to 40
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/BAND/Makefile 0000644 0001750 0001750 00000155362 12277671461 013717 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/BAND/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = cnbdr1$(EXEEXT) cnbdr2$(EXEEXT) cnbdr3$(EXEEXT) \
cnbdr4$(EXEEXT) dnbdr1$(EXEEXT) dnbdr2$(EXEEXT) \
dnbdr3$(EXEEXT) dnbdr4$(EXEEXT) dnbdr5$(EXEEXT) \
dnbdr6$(EXEEXT) dsbdr1$(EXEEXT) dsbdr2$(EXEEXT) \
dsbdr3$(EXEEXT) dsbdr4$(EXEEXT) dsbdr5$(EXEEXT) \
dsbdr6$(EXEEXT) snbdr1$(EXEEXT) snbdr2$(EXEEXT) \
snbdr3$(EXEEXT) snbdr4$(EXEEXT) snbdr5$(EXEEXT) \
snbdr6$(EXEEXT) ssbdr1$(EXEEXT) ssbdr2$(EXEEXT) \
ssbdr3$(EXEEXT) ssbdr4$(EXEEXT) ssbdr5$(EXEEXT) \
ssbdr6$(EXEEXT) znbdr1$(EXEEXT) znbdr2$(EXEEXT) \
znbdr3$(EXEEXT) znbdr4$(EXEEXT)
TESTS = cnbdr1$(EXEEXT) cnbdr2$(EXEEXT) cnbdr3$(EXEEXT) \
cnbdr4$(EXEEXT) dnbdr1$(EXEEXT) dnbdr2$(EXEEXT) \
dnbdr3$(EXEEXT) dnbdr4$(EXEEXT) dnbdr5$(EXEEXT) \
dnbdr6$(EXEEXT) dsbdr1$(EXEEXT) dsbdr2$(EXEEXT) \
dsbdr3$(EXEEXT) dsbdr4$(EXEEXT) dsbdr5$(EXEEXT) \
dsbdr6$(EXEEXT) snbdr1$(EXEEXT) snbdr2$(EXEEXT) \
snbdr3$(EXEEXT) snbdr4$(EXEEXT) snbdr5$(EXEEXT) \
snbdr6$(EXEEXT) ssbdr1$(EXEEXT) ssbdr2$(EXEEXT) \
ssbdr3$(EXEEXT) ssbdr4$(EXEEXT) ssbdr5$(EXEEXT) \
ssbdr6$(EXEEXT) znbdr1$(EXEEXT) znbdr2$(EXEEXT) \
znbdr3$(EXEEXT) znbdr4$(EXEEXT)
subdir = EXAMPLES/BAND
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cnbdr1_OBJECTS = cnbdr1.$(OBJEXT) cnband.$(OBJEXT)
cnbdr1_OBJECTS = $(am_cnbdr1_OBJECTS)
am__DEPENDENCIES_1 =
cnbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_cnbdr2_OBJECTS = cnbdr2.$(OBJEXT) cnband.$(OBJEXT)
cnbdr2_OBJECTS = $(am_cnbdr2_OBJECTS)
cnbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cnbdr3_OBJECTS = cnbdr3.$(OBJEXT) cnband.$(OBJEXT)
cnbdr3_OBJECTS = $(am_cnbdr3_OBJECTS)
cnbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cnbdr4_OBJECTS = cnbdr4.$(OBJEXT) cnband.$(OBJEXT)
cnbdr4_OBJECTS = $(am_cnbdr4_OBJECTS)
cnbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr1_OBJECTS = dnbdr1.$(OBJEXT) dnband.$(OBJEXT)
dnbdr1_OBJECTS = $(am_dnbdr1_OBJECTS)
dnbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr2_OBJECTS = dnbdr2.$(OBJEXT) dnband.$(OBJEXT)
dnbdr2_OBJECTS = $(am_dnbdr2_OBJECTS)
dnbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr3_OBJECTS = dnbdr3.$(OBJEXT) dnband.$(OBJEXT)
dnbdr3_OBJECTS = $(am_dnbdr3_OBJECTS)
dnbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr4_OBJECTS = dnbdr4.$(OBJEXT) dnband.$(OBJEXT)
dnbdr4_OBJECTS = $(am_dnbdr4_OBJECTS)
dnbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr5_OBJECTS = dnbdr5.$(OBJEXT) dnband.$(OBJEXT)
dnbdr5_OBJECTS = $(am_dnbdr5_OBJECTS)
dnbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr6_OBJECTS = dnbdr6.$(OBJEXT) dnband.$(OBJEXT)
dnbdr6_OBJECTS = $(am_dnbdr6_OBJECTS)
dnbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr1_OBJECTS = dsbdr1.$(OBJEXT) dsband.$(OBJEXT)
dsbdr1_OBJECTS = $(am_dsbdr1_OBJECTS)
dsbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr2_OBJECTS = dsbdr2.$(OBJEXT) dsband.$(OBJEXT)
dsbdr2_OBJECTS = $(am_dsbdr2_OBJECTS)
dsbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr3_OBJECTS = dsbdr3.$(OBJEXT) dsband.$(OBJEXT)
dsbdr3_OBJECTS = $(am_dsbdr3_OBJECTS)
dsbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr4_OBJECTS = dsbdr4.$(OBJEXT) dsband.$(OBJEXT)
dsbdr4_OBJECTS = $(am_dsbdr4_OBJECTS)
dsbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr5_OBJECTS = dsbdr5.$(OBJEXT) dsband.$(OBJEXT)
dsbdr5_OBJECTS = $(am_dsbdr5_OBJECTS)
dsbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr6_OBJECTS = dsbdr6.$(OBJEXT) dsband.$(OBJEXT)
dsbdr6_OBJECTS = $(am_dsbdr6_OBJECTS)
dsbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr1_OBJECTS = snbdr1.$(OBJEXT) snband.$(OBJEXT)
snbdr1_OBJECTS = $(am_snbdr1_OBJECTS)
snbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr2_OBJECTS = snbdr2.$(OBJEXT) snband.$(OBJEXT)
snbdr2_OBJECTS = $(am_snbdr2_OBJECTS)
snbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr3_OBJECTS = snbdr3.$(OBJEXT) snband.$(OBJEXT)
snbdr3_OBJECTS = $(am_snbdr3_OBJECTS)
snbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr4_OBJECTS = snbdr4.$(OBJEXT) snband.$(OBJEXT)
snbdr4_OBJECTS = $(am_snbdr4_OBJECTS)
snbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr5_OBJECTS = snbdr5.$(OBJEXT) snband.$(OBJEXT)
snbdr5_OBJECTS = $(am_snbdr5_OBJECTS)
snbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr6_OBJECTS = snbdr6.$(OBJEXT) snband.$(OBJEXT)
snbdr6_OBJECTS = $(am_snbdr6_OBJECTS)
snbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr1_OBJECTS = ssbdr1.$(OBJEXT) ssband.$(OBJEXT)
ssbdr1_OBJECTS = $(am_ssbdr1_OBJECTS)
ssbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr2_OBJECTS = ssbdr2.$(OBJEXT) ssband.$(OBJEXT)
ssbdr2_OBJECTS = $(am_ssbdr2_OBJECTS)
ssbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr3_OBJECTS = ssbdr3.$(OBJEXT) ssband.$(OBJEXT)
ssbdr3_OBJECTS = $(am_ssbdr3_OBJECTS)
ssbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr4_OBJECTS = ssbdr4.$(OBJEXT) ssband.$(OBJEXT)
ssbdr4_OBJECTS = $(am_ssbdr4_OBJECTS)
ssbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr5_OBJECTS = ssbdr5.$(OBJEXT) ssband.$(OBJEXT)
ssbdr5_OBJECTS = $(am_ssbdr5_OBJECTS)
ssbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr6_OBJECTS = ssbdr6.$(OBJEXT) ssband.$(OBJEXT)
ssbdr6_OBJECTS = $(am_ssbdr6_OBJECTS)
ssbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr1_OBJECTS = znbdr1.$(OBJEXT) znband.$(OBJEXT)
znbdr1_OBJECTS = $(am_znbdr1_OBJECTS)
znbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr2_OBJECTS = znbdr2.$(OBJEXT) znband.$(OBJEXT)
znbdr2_OBJECTS = $(am_znbdr2_OBJECTS)
znbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr3_OBJECTS = znbdr3.$(OBJEXT) znband.$(OBJEXT)
znbdr3_OBJECTS = $(am_znbdr3_OBJECTS)
znbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr4_OBJECTS = znbdr4.$(OBJEXT) znband.$(OBJEXT)
znbdr4_OBJECTS = $(am_znbdr4_OBJECTS)
znbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cnbdr1_SOURCES) $(cnbdr2_SOURCES) $(cnbdr3_SOURCES) \
$(cnbdr4_SOURCES) $(dnbdr1_SOURCES) $(dnbdr2_SOURCES) \
$(dnbdr3_SOURCES) $(dnbdr4_SOURCES) $(dnbdr5_SOURCES) \
$(dnbdr6_SOURCES) $(dsbdr1_SOURCES) $(dsbdr2_SOURCES) \
$(dsbdr3_SOURCES) $(dsbdr4_SOURCES) $(dsbdr5_SOURCES) \
$(dsbdr6_SOURCES) $(snbdr1_SOURCES) $(snbdr2_SOURCES) \
$(snbdr3_SOURCES) $(snbdr4_SOURCES) $(snbdr5_SOURCES) \
$(snbdr6_SOURCES) $(ssbdr1_SOURCES) $(ssbdr2_SOURCES) \
$(ssbdr3_SOURCES) $(ssbdr4_SOURCES) $(ssbdr5_SOURCES) \
$(ssbdr6_SOURCES) $(znbdr1_SOURCES) $(znbdr2_SOURCES) \
$(znbdr3_SOURCES) $(znbdr4_SOURCES)
DIST_SOURCES = $(cnbdr1_SOURCES) $(cnbdr2_SOURCES) $(cnbdr3_SOURCES) \
$(cnbdr4_SOURCES) $(dnbdr1_SOURCES) $(dnbdr2_SOURCES) \
$(dnbdr3_SOURCES) $(dnbdr4_SOURCES) $(dnbdr5_SOURCES) \
$(dnbdr6_SOURCES) $(dsbdr1_SOURCES) $(dsbdr2_SOURCES) \
$(dsbdr3_SOURCES) $(dsbdr4_SOURCES) $(dsbdr5_SOURCES) \
$(dsbdr6_SOURCES) $(snbdr1_SOURCES) $(snbdr2_SOURCES) \
$(snbdr3_SOURCES) $(snbdr4_SOURCES) $(snbdr5_SOURCES) \
$(snbdr6_SOURCES) $(ssbdr1_SOURCES) $(ssbdr2_SOURCES) \
$(ssbdr3_SOURCES) $(ssbdr4_SOURCES) $(ssbdr5_SOURCES) \
$(ssbdr6_SOURCES) $(znbdr1_SOURCES) $(znbdr2_SOURCES) \
$(znbdr3_SOURCES) $(znbdr4_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/BAND
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/BAND
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
cnbdr1_SOURCES = cnbdr1.f cnband.f
cnbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr2_SOURCES = cnbdr2.f cnband.f
cnbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr3_SOURCES = cnbdr3.f cnband.f
cnbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr4_SOURCES = cnbdr4.f cnband.f
cnbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr1_SOURCES = dnbdr1.f dnband.f
dnbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr2_SOURCES = dnbdr2.f dnband.f
dnbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr3_SOURCES = dnbdr3.f dnband.f
dnbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr4_SOURCES = dnbdr4.f dnband.f
dnbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr5_SOURCES = dnbdr5.f dnband.f
dnbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr6_SOURCES = dnbdr6.f dnband.f
dnbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr1_SOURCES = dsbdr1.f dsband.f
dsbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr2_SOURCES = dsbdr2.f dsband.f
dsbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr3_SOURCES = dsbdr3.f dsband.f
dsbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr4_SOURCES = dsbdr4.f dsband.f
dsbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr5_SOURCES = dsbdr5.f dsband.f
dsbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr6_SOURCES = dsbdr6.f dsband.f
dsbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snband_SOURCES = snband.f
snband_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr1_SOURCES = snbdr1.f snband.f
snbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr2_SOURCES = snbdr2.f snband.f
snbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr3_SOURCES = snbdr3.f snband.f
snbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr4_SOURCES = snbdr4.f snband.f
snbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr5_SOURCES = snbdr5.f snband.f
snbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr6_SOURCES = snbdr6.f snband.f
snbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr1_SOURCES = ssbdr1.f ssband.f
ssbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr2_SOURCES = ssbdr2.f ssband.f
ssbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr3_SOURCES = ssbdr3.f ssband.f
ssbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr4_SOURCES = ssbdr4.f ssband.f
ssbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr5_SOURCES = ssbdr5.f ssband.f
ssbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr6_SOURCES = ssbdr6.f ssband.f
ssbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr1_SOURCES = znbdr1.f znband.f
znbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr2_SOURCES = znbdr2.f znband.f
znbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr3_SOURCES = znbdr3.f znband.f
znbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr4_SOURCES = znbdr4.f znband.f
znbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/BAND/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/BAND/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cnbdr1$(EXEEXT): $(cnbdr1_OBJECTS) $(cnbdr1_DEPENDENCIES) $(EXTRA_cnbdr1_DEPENDENCIES)
@rm -f cnbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr1_OBJECTS) $(cnbdr1_LDADD) $(LIBS)
cnbdr2$(EXEEXT): $(cnbdr2_OBJECTS) $(cnbdr2_DEPENDENCIES) $(EXTRA_cnbdr2_DEPENDENCIES)
@rm -f cnbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr2_OBJECTS) $(cnbdr2_LDADD) $(LIBS)
cnbdr3$(EXEEXT): $(cnbdr3_OBJECTS) $(cnbdr3_DEPENDENCIES) $(EXTRA_cnbdr3_DEPENDENCIES)
@rm -f cnbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr3_OBJECTS) $(cnbdr3_LDADD) $(LIBS)
cnbdr4$(EXEEXT): $(cnbdr4_OBJECTS) $(cnbdr4_DEPENDENCIES) $(EXTRA_cnbdr4_DEPENDENCIES)
@rm -f cnbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr4_OBJECTS) $(cnbdr4_LDADD) $(LIBS)
dnbdr1$(EXEEXT): $(dnbdr1_OBJECTS) $(dnbdr1_DEPENDENCIES) $(EXTRA_dnbdr1_DEPENDENCIES)
@rm -f dnbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr1_OBJECTS) $(dnbdr1_LDADD) $(LIBS)
dnbdr2$(EXEEXT): $(dnbdr2_OBJECTS) $(dnbdr2_DEPENDENCIES) $(EXTRA_dnbdr2_DEPENDENCIES)
@rm -f dnbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr2_OBJECTS) $(dnbdr2_LDADD) $(LIBS)
dnbdr3$(EXEEXT): $(dnbdr3_OBJECTS) $(dnbdr3_DEPENDENCIES) $(EXTRA_dnbdr3_DEPENDENCIES)
@rm -f dnbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr3_OBJECTS) $(dnbdr3_LDADD) $(LIBS)
dnbdr4$(EXEEXT): $(dnbdr4_OBJECTS) $(dnbdr4_DEPENDENCIES) $(EXTRA_dnbdr4_DEPENDENCIES)
@rm -f dnbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr4_OBJECTS) $(dnbdr4_LDADD) $(LIBS)
dnbdr5$(EXEEXT): $(dnbdr5_OBJECTS) $(dnbdr5_DEPENDENCIES) $(EXTRA_dnbdr5_DEPENDENCIES)
@rm -f dnbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr5_OBJECTS) $(dnbdr5_LDADD) $(LIBS)
dnbdr6$(EXEEXT): $(dnbdr6_OBJECTS) $(dnbdr6_DEPENDENCIES) $(EXTRA_dnbdr6_DEPENDENCIES)
@rm -f dnbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr6_OBJECTS) $(dnbdr6_LDADD) $(LIBS)
dsbdr1$(EXEEXT): $(dsbdr1_OBJECTS) $(dsbdr1_DEPENDENCIES) $(EXTRA_dsbdr1_DEPENDENCIES)
@rm -f dsbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr1_OBJECTS) $(dsbdr1_LDADD) $(LIBS)
dsbdr2$(EXEEXT): $(dsbdr2_OBJECTS) $(dsbdr2_DEPENDENCIES) $(EXTRA_dsbdr2_DEPENDENCIES)
@rm -f dsbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr2_OBJECTS) $(dsbdr2_LDADD) $(LIBS)
dsbdr3$(EXEEXT): $(dsbdr3_OBJECTS) $(dsbdr3_DEPENDENCIES) $(EXTRA_dsbdr3_DEPENDENCIES)
@rm -f dsbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr3_OBJECTS) $(dsbdr3_LDADD) $(LIBS)
dsbdr4$(EXEEXT): $(dsbdr4_OBJECTS) $(dsbdr4_DEPENDENCIES) $(EXTRA_dsbdr4_DEPENDENCIES)
@rm -f dsbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr4_OBJECTS) $(dsbdr4_LDADD) $(LIBS)
dsbdr5$(EXEEXT): $(dsbdr5_OBJECTS) $(dsbdr5_DEPENDENCIES) $(EXTRA_dsbdr5_DEPENDENCIES)
@rm -f dsbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr5_OBJECTS) $(dsbdr5_LDADD) $(LIBS)
dsbdr6$(EXEEXT): $(dsbdr6_OBJECTS) $(dsbdr6_DEPENDENCIES) $(EXTRA_dsbdr6_DEPENDENCIES)
@rm -f dsbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr6_OBJECTS) $(dsbdr6_LDADD) $(LIBS)
snbdr1$(EXEEXT): $(snbdr1_OBJECTS) $(snbdr1_DEPENDENCIES) $(EXTRA_snbdr1_DEPENDENCIES)
@rm -f snbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr1_OBJECTS) $(snbdr1_LDADD) $(LIBS)
snbdr2$(EXEEXT): $(snbdr2_OBJECTS) $(snbdr2_DEPENDENCIES) $(EXTRA_snbdr2_DEPENDENCIES)
@rm -f snbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr2_OBJECTS) $(snbdr2_LDADD) $(LIBS)
snbdr3$(EXEEXT): $(snbdr3_OBJECTS) $(snbdr3_DEPENDENCIES) $(EXTRA_snbdr3_DEPENDENCIES)
@rm -f snbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr3_OBJECTS) $(snbdr3_LDADD) $(LIBS)
snbdr4$(EXEEXT): $(snbdr4_OBJECTS) $(snbdr4_DEPENDENCIES) $(EXTRA_snbdr4_DEPENDENCIES)
@rm -f snbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr4_OBJECTS) $(snbdr4_LDADD) $(LIBS)
snbdr5$(EXEEXT): $(snbdr5_OBJECTS) $(snbdr5_DEPENDENCIES) $(EXTRA_snbdr5_DEPENDENCIES)
@rm -f snbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr5_OBJECTS) $(snbdr5_LDADD) $(LIBS)
snbdr6$(EXEEXT): $(snbdr6_OBJECTS) $(snbdr6_DEPENDENCIES) $(EXTRA_snbdr6_DEPENDENCIES)
@rm -f snbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr6_OBJECTS) $(snbdr6_LDADD) $(LIBS)
ssbdr1$(EXEEXT): $(ssbdr1_OBJECTS) $(ssbdr1_DEPENDENCIES) $(EXTRA_ssbdr1_DEPENDENCIES)
@rm -f ssbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr1_OBJECTS) $(ssbdr1_LDADD) $(LIBS)
ssbdr2$(EXEEXT): $(ssbdr2_OBJECTS) $(ssbdr2_DEPENDENCIES) $(EXTRA_ssbdr2_DEPENDENCIES)
@rm -f ssbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr2_OBJECTS) $(ssbdr2_LDADD) $(LIBS)
ssbdr3$(EXEEXT): $(ssbdr3_OBJECTS) $(ssbdr3_DEPENDENCIES) $(EXTRA_ssbdr3_DEPENDENCIES)
@rm -f ssbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr3_OBJECTS) $(ssbdr3_LDADD) $(LIBS)
ssbdr4$(EXEEXT): $(ssbdr4_OBJECTS) $(ssbdr4_DEPENDENCIES) $(EXTRA_ssbdr4_DEPENDENCIES)
@rm -f ssbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr4_OBJECTS) $(ssbdr4_LDADD) $(LIBS)
ssbdr5$(EXEEXT): $(ssbdr5_OBJECTS) $(ssbdr5_DEPENDENCIES) $(EXTRA_ssbdr5_DEPENDENCIES)
@rm -f ssbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr5_OBJECTS) $(ssbdr5_LDADD) $(LIBS)
ssbdr6$(EXEEXT): $(ssbdr6_OBJECTS) $(ssbdr6_DEPENDENCIES) $(EXTRA_ssbdr6_DEPENDENCIES)
@rm -f ssbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr6_OBJECTS) $(ssbdr6_LDADD) $(LIBS)
znbdr1$(EXEEXT): $(znbdr1_OBJECTS) $(znbdr1_DEPENDENCIES) $(EXTRA_znbdr1_DEPENDENCIES)
@rm -f znbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr1_OBJECTS) $(znbdr1_LDADD) $(LIBS)
znbdr2$(EXEEXT): $(znbdr2_OBJECTS) $(znbdr2_DEPENDENCIES) $(EXTRA_znbdr2_DEPENDENCIES)
@rm -f znbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr2_OBJECTS) $(znbdr2_LDADD) $(LIBS)
znbdr3$(EXEEXT): $(znbdr3_OBJECTS) $(znbdr3_DEPENDENCIES) $(EXTRA_znbdr3_DEPENDENCIES)
@rm -f znbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr3_OBJECTS) $(znbdr3_LDADD) $(LIBS)
znbdr4$(EXEEXT): $(znbdr4_OBJECTS) $(znbdr4_DEPENDENCIES) $(EXTRA_znbdr4_DEPENDENCIES)
@rm -f znbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr4_OBJECTS) $(znbdr4_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cnbdr1.log: cnbdr1$(EXEEXT)
@p='cnbdr1$(EXEEXT)'; \
b='cnbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr2.log: cnbdr2$(EXEEXT)
@p='cnbdr2$(EXEEXT)'; \
b='cnbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr3.log: cnbdr3$(EXEEXT)
@p='cnbdr3$(EXEEXT)'; \
b='cnbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr4.log: cnbdr4$(EXEEXT)
@p='cnbdr4$(EXEEXT)'; \
b='cnbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr1.log: dnbdr1$(EXEEXT)
@p='dnbdr1$(EXEEXT)'; \
b='dnbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr2.log: dnbdr2$(EXEEXT)
@p='dnbdr2$(EXEEXT)'; \
b='dnbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr3.log: dnbdr3$(EXEEXT)
@p='dnbdr3$(EXEEXT)'; \
b='dnbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr4.log: dnbdr4$(EXEEXT)
@p='dnbdr4$(EXEEXT)'; \
b='dnbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr5.log: dnbdr5$(EXEEXT)
@p='dnbdr5$(EXEEXT)'; \
b='dnbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr6.log: dnbdr6$(EXEEXT)
@p='dnbdr6$(EXEEXT)'; \
b='dnbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr1.log: dsbdr1$(EXEEXT)
@p='dsbdr1$(EXEEXT)'; \
b='dsbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr2.log: dsbdr2$(EXEEXT)
@p='dsbdr2$(EXEEXT)'; \
b='dsbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr3.log: dsbdr3$(EXEEXT)
@p='dsbdr3$(EXEEXT)'; \
b='dsbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr4.log: dsbdr4$(EXEEXT)
@p='dsbdr4$(EXEEXT)'; \
b='dsbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr5.log: dsbdr5$(EXEEXT)
@p='dsbdr5$(EXEEXT)'; \
b='dsbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr6.log: dsbdr6$(EXEEXT)
@p='dsbdr6$(EXEEXT)'; \
b='dsbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr1.log: snbdr1$(EXEEXT)
@p='snbdr1$(EXEEXT)'; \
b='snbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr2.log: snbdr2$(EXEEXT)
@p='snbdr2$(EXEEXT)'; \
b='snbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr3.log: snbdr3$(EXEEXT)
@p='snbdr3$(EXEEXT)'; \
b='snbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr4.log: snbdr4$(EXEEXT)
@p='snbdr4$(EXEEXT)'; \
b='snbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr5.log: snbdr5$(EXEEXT)
@p='snbdr5$(EXEEXT)'; \
b='snbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr6.log: snbdr6$(EXEEXT)
@p='snbdr6$(EXEEXT)'; \
b='snbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr1.log: ssbdr1$(EXEEXT)
@p='ssbdr1$(EXEEXT)'; \
b='ssbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr2.log: ssbdr2$(EXEEXT)
@p='ssbdr2$(EXEEXT)'; \
b='ssbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr3.log: ssbdr3$(EXEEXT)
@p='ssbdr3$(EXEEXT)'; \
b='ssbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr4.log: ssbdr4$(EXEEXT)
@p='ssbdr4$(EXEEXT)'; \
b='ssbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr5.log: ssbdr5$(EXEEXT)
@p='ssbdr5$(EXEEXT)'; \
b='ssbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr6.log: ssbdr6$(EXEEXT)
@p='ssbdr6$(EXEEXT)'; \
b='ssbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr1.log: znbdr1$(EXEEXT)
@p='znbdr1$(EXEEXT)'; \
b='znbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr2.log: znbdr2$(EXEEXT)
@p='znbdr2$(EXEEXT)'; \
b='znbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr3.log: znbdr3$(EXEEXT)
@p='znbdr3$(EXEEXT)'; \
b='znbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr4.log: znbdr4$(EXEEXT)
@p='znbdr4$(EXEEXT)'; \
b='znbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr5.f 0000644 0001750 0001750 00000023501 12277373057 013576 0000000 0000000 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 such that
c A*x = M*x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Double precision
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2 , dnrm2
external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. Since the Buckling mode is |
c | is used, WHICH is set to 'LM'. The user can |
c | modify N, NEV, NCV and SIGMA to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 1.0
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR5 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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,
& 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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr2.f 0000644 0001750 0001750 00000024175 12277373057 013622 0000000 0000000 program ssbdr2
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-dimensional Laplacian on the unit square
c with zero Dirichlet boundary condition using standard
c central difference.
c
c ... Call SSBAND to find eigenvalues LAMBDA closest to
c SIGMA such that
c A*x = x*LAMBDA.
c
c ... Use mode 3 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
Real
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
& ax(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
Real
& tol, sigma, h2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian operator on the unit square with zero |
c | Dirichlet boundary condition. The number |
c | N(=NX*NX) is the dimension of the matrix. A |
c | standard eigenvalue problem is solved |
c | (BMAT = 'I'). NEV is the number of eigenvalues |
c | (closest to the shift SIGMA) to be approximated. |
c | Since the shift and invert mode is used, WHICH |
c | is set to 'LM'. The user can modify NX, NEV, |
c | NCV and SIGMA to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of SSAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0E+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one / h2
a(isub,j) = -one / h2
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR2 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/.deps/ 0000755 0001750 0001750 00000000000 12277670371 013333 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/BAND/.deps/cnband.Po 0000644 0001750 0001750 00000000010 12277670371 014767 0000000 0000000 # dummy
arpack-ng-3.1.5/EXAMPLES/BAND/Makefile.in 0000644 0001750 0001750 00000153520 12277671063 014314 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = cnbdr1$(EXEEXT) cnbdr2$(EXEEXT) cnbdr3$(EXEEXT) \
cnbdr4$(EXEEXT) dnbdr1$(EXEEXT) dnbdr2$(EXEEXT) \
dnbdr3$(EXEEXT) dnbdr4$(EXEEXT) dnbdr5$(EXEEXT) \
dnbdr6$(EXEEXT) dsbdr1$(EXEEXT) dsbdr2$(EXEEXT) \
dsbdr3$(EXEEXT) dsbdr4$(EXEEXT) dsbdr5$(EXEEXT) \
dsbdr6$(EXEEXT) snbdr1$(EXEEXT) snbdr2$(EXEEXT) \
snbdr3$(EXEEXT) snbdr4$(EXEEXT) snbdr5$(EXEEXT) \
snbdr6$(EXEEXT) ssbdr1$(EXEEXT) ssbdr2$(EXEEXT) \
ssbdr3$(EXEEXT) ssbdr4$(EXEEXT) ssbdr5$(EXEEXT) \
ssbdr6$(EXEEXT) znbdr1$(EXEEXT) znbdr2$(EXEEXT) \
znbdr3$(EXEEXT) znbdr4$(EXEEXT)
TESTS = cnbdr1$(EXEEXT) cnbdr2$(EXEEXT) cnbdr3$(EXEEXT) \
cnbdr4$(EXEEXT) dnbdr1$(EXEEXT) dnbdr2$(EXEEXT) \
dnbdr3$(EXEEXT) dnbdr4$(EXEEXT) dnbdr5$(EXEEXT) \
dnbdr6$(EXEEXT) dsbdr1$(EXEEXT) dsbdr2$(EXEEXT) \
dsbdr3$(EXEEXT) dsbdr4$(EXEEXT) dsbdr5$(EXEEXT) \
dsbdr6$(EXEEXT) snbdr1$(EXEEXT) snbdr2$(EXEEXT) \
snbdr3$(EXEEXT) snbdr4$(EXEEXT) snbdr5$(EXEEXT) \
snbdr6$(EXEEXT) ssbdr1$(EXEEXT) ssbdr2$(EXEEXT) \
ssbdr3$(EXEEXT) ssbdr4$(EXEEXT) ssbdr5$(EXEEXT) \
ssbdr6$(EXEEXT) znbdr1$(EXEEXT) znbdr2$(EXEEXT) \
znbdr3$(EXEEXT) znbdr4$(EXEEXT)
subdir = EXAMPLES/BAND
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_cnbdr1_OBJECTS = cnbdr1.$(OBJEXT) cnband.$(OBJEXT)
cnbdr1_OBJECTS = $(am_cnbdr1_OBJECTS)
am__DEPENDENCIES_1 =
cnbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_cnbdr2_OBJECTS = cnbdr2.$(OBJEXT) cnband.$(OBJEXT)
cnbdr2_OBJECTS = $(am_cnbdr2_OBJECTS)
cnbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cnbdr3_OBJECTS = cnbdr3.$(OBJEXT) cnband.$(OBJEXT)
cnbdr3_OBJECTS = $(am_cnbdr3_OBJECTS)
cnbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_cnbdr4_OBJECTS = cnbdr4.$(OBJEXT) cnband.$(OBJEXT)
cnbdr4_OBJECTS = $(am_cnbdr4_OBJECTS)
cnbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr1_OBJECTS = dnbdr1.$(OBJEXT) dnband.$(OBJEXT)
dnbdr1_OBJECTS = $(am_dnbdr1_OBJECTS)
dnbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr2_OBJECTS = dnbdr2.$(OBJEXT) dnband.$(OBJEXT)
dnbdr2_OBJECTS = $(am_dnbdr2_OBJECTS)
dnbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr3_OBJECTS = dnbdr3.$(OBJEXT) dnband.$(OBJEXT)
dnbdr3_OBJECTS = $(am_dnbdr3_OBJECTS)
dnbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr4_OBJECTS = dnbdr4.$(OBJEXT) dnband.$(OBJEXT)
dnbdr4_OBJECTS = $(am_dnbdr4_OBJECTS)
dnbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr5_OBJECTS = dnbdr5.$(OBJEXT) dnband.$(OBJEXT)
dnbdr5_OBJECTS = $(am_dnbdr5_OBJECTS)
dnbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dnbdr6_OBJECTS = dnbdr6.$(OBJEXT) dnband.$(OBJEXT)
dnbdr6_OBJECTS = $(am_dnbdr6_OBJECTS)
dnbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr1_OBJECTS = dsbdr1.$(OBJEXT) dsband.$(OBJEXT)
dsbdr1_OBJECTS = $(am_dsbdr1_OBJECTS)
dsbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr2_OBJECTS = dsbdr2.$(OBJEXT) dsband.$(OBJEXT)
dsbdr2_OBJECTS = $(am_dsbdr2_OBJECTS)
dsbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr3_OBJECTS = dsbdr3.$(OBJEXT) dsband.$(OBJEXT)
dsbdr3_OBJECTS = $(am_dsbdr3_OBJECTS)
dsbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr4_OBJECTS = dsbdr4.$(OBJEXT) dsband.$(OBJEXT)
dsbdr4_OBJECTS = $(am_dsbdr4_OBJECTS)
dsbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr5_OBJECTS = dsbdr5.$(OBJEXT) dsband.$(OBJEXT)
dsbdr5_OBJECTS = $(am_dsbdr5_OBJECTS)
dsbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsbdr6_OBJECTS = dsbdr6.$(OBJEXT) dsband.$(OBJEXT)
dsbdr6_OBJECTS = $(am_dsbdr6_OBJECTS)
dsbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr1_OBJECTS = snbdr1.$(OBJEXT) snband.$(OBJEXT)
snbdr1_OBJECTS = $(am_snbdr1_OBJECTS)
snbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr2_OBJECTS = snbdr2.$(OBJEXT) snband.$(OBJEXT)
snbdr2_OBJECTS = $(am_snbdr2_OBJECTS)
snbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr3_OBJECTS = snbdr3.$(OBJEXT) snband.$(OBJEXT)
snbdr3_OBJECTS = $(am_snbdr3_OBJECTS)
snbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr4_OBJECTS = snbdr4.$(OBJEXT) snband.$(OBJEXT)
snbdr4_OBJECTS = $(am_snbdr4_OBJECTS)
snbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr5_OBJECTS = snbdr5.$(OBJEXT) snband.$(OBJEXT)
snbdr5_OBJECTS = $(am_snbdr5_OBJECTS)
snbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_snbdr6_OBJECTS = snbdr6.$(OBJEXT) snband.$(OBJEXT)
snbdr6_OBJECTS = $(am_snbdr6_OBJECTS)
snbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr1_OBJECTS = ssbdr1.$(OBJEXT) ssband.$(OBJEXT)
ssbdr1_OBJECTS = $(am_ssbdr1_OBJECTS)
ssbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr2_OBJECTS = ssbdr2.$(OBJEXT) ssband.$(OBJEXT)
ssbdr2_OBJECTS = $(am_ssbdr2_OBJECTS)
ssbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr3_OBJECTS = ssbdr3.$(OBJEXT) ssband.$(OBJEXT)
ssbdr3_OBJECTS = $(am_ssbdr3_OBJECTS)
ssbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr4_OBJECTS = ssbdr4.$(OBJEXT) ssband.$(OBJEXT)
ssbdr4_OBJECTS = $(am_ssbdr4_OBJECTS)
ssbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr5_OBJECTS = ssbdr5.$(OBJEXT) ssband.$(OBJEXT)
ssbdr5_OBJECTS = $(am_ssbdr5_OBJECTS)
ssbdr5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssbdr6_OBJECTS = ssbdr6.$(OBJEXT) ssband.$(OBJEXT)
ssbdr6_OBJECTS = $(am_ssbdr6_OBJECTS)
ssbdr6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr1_OBJECTS = znbdr1.$(OBJEXT) znband.$(OBJEXT)
znbdr1_OBJECTS = $(am_znbdr1_OBJECTS)
znbdr1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr2_OBJECTS = znbdr2.$(OBJEXT) znband.$(OBJEXT)
znbdr2_OBJECTS = $(am_znbdr2_OBJECTS)
znbdr2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr3_OBJECTS = znbdr3.$(OBJEXT) znband.$(OBJEXT)
znbdr3_OBJECTS = $(am_znbdr3_OBJECTS)
znbdr3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_znbdr4_OBJECTS = znbdr4.$(OBJEXT) znband.$(OBJEXT)
znbdr4_OBJECTS = $(am_znbdr4_OBJECTS)
znbdr4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(cnbdr1_SOURCES) $(cnbdr2_SOURCES) $(cnbdr3_SOURCES) \
$(cnbdr4_SOURCES) $(dnbdr1_SOURCES) $(dnbdr2_SOURCES) \
$(dnbdr3_SOURCES) $(dnbdr4_SOURCES) $(dnbdr5_SOURCES) \
$(dnbdr6_SOURCES) $(dsbdr1_SOURCES) $(dsbdr2_SOURCES) \
$(dsbdr3_SOURCES) $(dsbdr4_SOURCES) $(dsbdr5_SOURCES) \
$(dsbdr6_SOURCES) $(snbdr1_SOURCES) $(snbdr2_SOURCES) \
$(snbdr3_SOURCES) $(snbdr4_SOURCES) $(snbdr5_SOURCES) \
$(snbdr6_SOURCES) $(ssbdr1_SOURCES) $(ssbdr2_SOURCES) \
$(ssbdr3_SOURCES) $(ssbdr4_SOURCES) $(ssbdr5_SOURCES) \
$(ssbdr6_SOURCES) $(znbdr1_SOURCES) $(znbdr2_SOURCES) \
$(znbdr3_SOURCES) $(znbdr4_SOURCES)
DIST_SOURCES = $(cnbdr1_SOURCES) $(cnbdr2_SOURCES) $(cnbdr3_SOURCES) \
$(cnbdr4_SOURCES) $(dnbdr1_SOURCES) $(dnbdr2_SOURCES) \
$(dnbdr3_SOURCES) $(dnbdr4_SOURCES) $(dnbdr5_SOURCES) \
$(dnbdr6_SOURCES) $(dsbdr1_SOURCES) $(dsbdr2_SOURCES) \
$(dsbdr3_SOURCES) $(dsbdr4_SOURCES) $(dsbdr5_SOURCES) \
$(dsbdr6_SOURCES) $(snbdr1_SOURCES) $(snbdr2_SOURCES) \
$(snbdr3_SOURCES) $(snbdr4_SOURCES) $(snbdr5_SOURCES) \
$(snbdr6_SOURCES) $(ssbdr1_SOURCES) $(ssbdr2_SOURCES) \
$(ssbdr3_SOURCES) $(ssbdr4_SOURCES) $(ssbdr5_SOURCES) \
$(ssbdr6_SOURCES) $(znbdr1_SOURCES) $(znbdr2_SOURCES) \
$(znbdr3_SOURCES) $(znbdr4_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
cnbdr1_SOURCES = cnbdr1.f cnband.f
cnbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr2_SOURCES = cnbdr2.f cnband.f
cnbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr3_SOURCES = cnbdr3.f cnband.f
cnbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
cnbdr4_SOURCES = cnbdr4.f cnband.f
cnbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr1_SOURCES = dnbdr1.f dnband.f
dnbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr2_SOURCES = dnbdr2.f dnband.f
dnbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr3_SOURCES = dnbdr3.f dnband.f
dnbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr4_SOURCES = dnbdr4.f dnband.f
dnbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr5_SOURCES = dnbdr5.f dnband.f
dnbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dnbdr6_SOURCES = dnbdr6.f dnband.f
dnbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr1_SOURCES = dsbdr1.f dsband.f
dsbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr2_SOURCES = dsbdr2.f dsband.f
dsbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr3_SOURCES = dsbdr3.f dsband.f
dsbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr4_SOURCES = dsbdr4.f dsband.f
dsbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr5_SOURCES = dsbdr5.f dsband.f
dsbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsbdr6_SOURCES = dsbdr6.f dsband.f
dsbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snband_SOURCES = snband.f
snband_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr1_SOURCES = snbdr1.f snband.f
snbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr2_SOURCES = snbdr2.f snband.f
snbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr3_SOURCES = snbdr3.f snband.f
snbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr4_SOURCES = snbdr4.f snband.f
snbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr5_SOURCES = snbdr5.f snband.f
snbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
snbdr6_SOURCES = snbdr6.f snband.f
snbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr1_SOURCES = ssbdr1.f ssband.f
ssbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr2_SOURCES = ssbdr2.f ssband.f
ssbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr3_SOURCES = ssbdr3.f ssband.f
ssbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr4_SOURCES = ssbdr4.f ssband.f
ssbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr5_SOURCES = ssbdr5.f ssband.f
ssbdr5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssbdr6_SOURCES = ssbdr6.f ssband.f
ssbdr6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr1_SOURCES = znbdr1.f znband.f
znbdr1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr2_SOURCES = znbdr2.f znband.f
znbdr2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr3_SOURCES = znbdr3.f znband.f
znbdr3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
znbdr4_SOURCES = znbdr4.f znband.f
znbdr4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/BAND/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/BAND/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
cnbdr1$(EXEEXT): $(cnbdr1_OBJECTS) $(cnbdr1_DEPENDENCIES) $(EXTRA_cnbdr1_DEPENDENCIES)
@rm -f cnbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr1_OBJECTS) $(cnbdr1_LDADD) $(LIBS)
cnbdr2$(EXEEXT): $(cnbdr2_OBJECTS) $(cnbdr2_DEPENDENCIES) $(EXTRA_cnbdr2_DEPENDENCIES)
@rm -f cnbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr2_OBJECTS) $(cnbdr2_LDADD) $(LIBS)
cnbdr3$(EXEEXT): $(cnbdr3_OBJECTS) $(cnbdr3_DEPENDENCIES) $(EXTRA_cnbdr3_DEPENDENCIES)
@rm -f cnbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr3_OBJECTS) $(cnbdr3_LDADD) $(LIBS)
cnbdr4$(EXEEXT): $(cnbdr4_OBJECTS) $(cnbdr4_DEPENDENCIES) $(EXTRA_cnbdr4_DEPENDENCIES)
@rm -f cnbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(cnbdr4_OBJECTS) $(cnbdr4_LDADD) $(LIBS)
dnbdr1$(EXEEXT): $(dnbdr1_OBJECTS) $(dnbdr1_DEPENDENCIES) $(EXTRA_dnbdr1_DEPENDENCIES)
@rm -f dnbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr1_OBJECTS) $(dnbdr1_LDADD) $(LIBS)
dnbdr2$(EXEEXT): $(dnbdr2_OBJECTS) $(dnbdr2_DEPENDENCIES) $(EXTRA_dnbdr2_DEPENDENCIES)
@rm -f dnbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr2_OBJECTS) $(dnbdr2_LDADD) $(LIBS)
dnbdr3$(EXEEXT): $(dnbdr3_OBJECTS) $(dnbdr3_DEPENDENCIES) $(EXTRA_dnbdr3_DEPENDENCIES)
@rm -f dnbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr3_OBJECTS) $(dnbdr3_LDADD) $(LIBS)
dnbdr4$(EXEEXT): $(dnbdr4_OBJECTS) $(dnbdr4_DEPENDENCIES) $(EXTRA_dnbdr4_DEPENDENCIES)
@rm -f dnbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr4_OBJECTS) $(dnbdr4_LDADD) $(LIBS)
dnbdr5$(EXEEXT): $(dnbdr5_OBJECTS) $(dnbdr5_DEPENDENCIES) $(EXTRA_dnbdr5_DEPENDENCIES)
@rm -f dnbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr5_OBJECTS) $(dnbdr5_LDADD) $(LIBS)
dnbdr6$(EXEEXT): $(dnbdr6_OBJECTS) $(dnbdr6_DEPENDENCIES) $(EXTRA_dnbdr6_DEPENDENCIES)
@rm -f dnbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnbdr6_OBJECTS) $(dnbdr6_LDADD) $(LIBS)
dsbdr1$(EXEEXT): $(dsbdr1_OBJECTS) $(dsbdr1_DEPENDENCIES) $(EXTRA_dsbdr1_DEPENDENCIES)
@rm -f dsbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr1_OBJECTS) $(dsbdr1_LDADD) $(LIBS)
dsbdr2$(EXEEXT): $(dsbdr2_OBJECTS) $(dsbdr2_DEPENDENCIES) $(EXTRA_dsbdr2_DEPENDENCIES)
@rm -f dsbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr2_OBJECTS) $(dsbdr2_LDADD) $(LIBS)
dsbdr3$(EXEEXT): $(dsbdr3_OBJECTS) $(dsbdr3_DEPENDENCIES) $(EXTRA_dsbdr3_DEPENDENCIES)
@rm -f dsbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr3_OBJECTS) $(dsbdr3_LDADD) $(LIBS)
dsbdr4$(EXEEXT): $(dsbdr4_OBJECTS) $(dsbdr4_DEPENDENCIES) $(EXTRA_dsbdr4_DEPENDENCIES)
@rm -f dsbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr4_OBJECTS) $(dsbdr4_LDADD) $(LIBS)
dsbdr5$(EXEEXT): $(dsbdr5_OBJECTS) $(dsbdr5_DEPENDENCIES) $(EXTRA_dsbdr5_DEPENDENCIES)
@rm -f dsbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr5_OBJECTS) $(dsbdr5_LDADD) $(LIBS)
dsbdr6$(EXEEXT): $(dsbdr6_OBJECTS) $(dsbdr6_DEPENDENCIES) $(EXTRA_dsbdr6_DEPENDENCIES)
@rm -f dsbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsbdr6_OBJECTS) $(dsbdr6_LDADD) $(LIBS)
snbdr1$(EXEEXT): $(snbdr1_OBJECTS) $(snbdr1_DEPENDENCIES) $(EXTRA_snbdr1_DEPENDENCIES)
@rm -f snbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr1_OBJECTS) $(snbdr1_LDADD) $(LIBS)
snbdr2$(EXEEXT): $(snbdr2_OBJECTS) $(snbdr2_DEPENDENCIES) $(EXTRA_snbdr2_DEPENDENCIES)
@rm -f snbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr2_OBJECTS) $(snbdr2_LDADD) $(LIBS)
snbdr3$(EXEEXT): $(snbdr3_OBJECTS) $(snbdr3_DEPENDENCIES) $(EXTRA_snbdr3_DEPENDENCIES)
@rm -f snbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr3_OBJECTS) $(snbdr3_LDADD) $(LIBS)
snbdr4$(EXEEXT): $(snbdr4_OBJECTS) $(snbdr4_DEPENDENCIES) $(EXTRA_snbdr4_DEPENDENCIES)
@rm -f snbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr4_OBJECTS) $(snbdr4_LDADD) $(LIBS)
snbdr5$(EXEEXT): $(snbdr5_OBJECTS) $(snbdr5_DEPENDENCIES) $(EXTRA_snbdr5_DEPENDENCIES)
@rm -f snbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr5_OBJECTS) $(snbdr5_LDADD) $(LIBS)
snbdr6$(EXEEXT): $(snbdr6_OBJECTS) $(snbdr6_DEPENDENCIES) $(EXTRA_snbdr6_DEPENDENCIES)
@rm -f snbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(snbdr6_OBJECTS) $(snbdr6_LDADD) $(LIBS)
ssbdr1$(EXEEXT): $(ssbdr1_OBJECTS) $(ssbdr1_DEPENDENCIES) $(EXTRA_ssbdr1_DEPENDENCIES)
@rm -f ssbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr1_OBJECTS) $(ssbdr1_LDADD) $(LIBS)
ssbdr2$(EXEEXT): $(ssbdr2_OBJECTS) $(ssbdr2_DEPENDENCIES) $(EXTRA_ssbdr2_DEPENDENCIES)
@rm -f ssbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr2_OBJECTS) $(ssbdr2_LDADD) $(LIBS)
ssbdr3$(EXEEXT): $(ssbdr3_OBJECTS) $(ssbdr3_DEPENDENCIES) $(EXTRA_ssbdr3_DEPENDENCIES)
@rm -f ssbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr3_OBJECTS) $(ssbdr3_LDADD) $(LIBS)
ssbdr4$(EXEEXT): $(ssbdr4_OBJECTS) $(ssbdr4_DEPENDENCIES) $(EXTRA_ssbdr4_DEPENDENCIES)
@rm -f ssbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr4_OBJECTS) $(ssbdr4_LDADD) $(LIBS)
ssbdr5$(EXEEXT): $(ssbdr5_OBJECTS) $(ssbdr5_DEPENDENCIES) $(EXTRA_ssbdr5_DEPENDENCIES)
@rm -f ssbdr5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr5_OBJECTS) $(ssbdr5_LDADD) $(LIBS)
ssbdr6$(EXEEXT): $(ssbdr6_OBJECTS) $(ssbdr6_DEPENDENCIES) $(EXTRA_ssbdr6_DEPENDENCIES)
@rm -f ssbdr6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssbdr6_OBJECTS) $(ssbdr6_LDADD) $(LIBS)
znbdr1$(EXEEXT): $(znbdr1_OBJECTS) $(znbdr1_DEPENDENCIES) $(EXTRA_znbdr1_DEPENDENCIES)
@rm -f znbdr1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr1_OBJECTS) $(znbdr1_LDADD) $(LIBS)
znbdr2$(EXEEXT): $(znbdr2_OBJECTS) $(znbdr2_DEPENDENCIES) $(EXTRA_znbdr2_DEPENDENCIES)
@rm -f znbdr2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr2_OBJECTS) $(znbdr2_LDADD) $(LIBS)
znbdr3$(EXEEXT): $(znbdr3_OBJECTS) $(znbdr3_DEPENDENCIES) $(EXTRA_znbdr3_DEPENDENCIES)
@rm -f znbdr3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr3_OBJECTS) $(znbdr3_LDADD) $(LIBS)
znbdr4$(EXEEXT): $(znbdr4_OBJECTS) $(znbdr4_DEPENDENCIES) $(EXTRA_znbdr4_DEPENDENCIES)
@rm -f znbdr4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(znbdr4_OBJECTS) $(znbdr4_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
cnbdr1.log: cnbdr1$(EXEEXT)
@p='cnbdr1$(EXEEXT)'; \
b='cnbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr2.log: cnbdr2$(EXEEXT)
@p='cnbdr2$(EXEEXT)'; \
b='cnbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr3.log: cnbdr3$(EXEEXT)
@p='cnbdr3$(EXEEXT)'; \
b='cnbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
cnbdr4.log: cnbdr4$(EXEEXT)
@p='cnbdr4$(EXEEXT)'; \
b='cnbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr1.log: dnbdr1$(EXEEXT)
@p='dnbdr1$(EXEEXT)'; \
b='dnbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr2.log: dnbdr2$(EXEEXT)
@p='dnbdr2$(EXEEXT)'; \
b='dnbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr3.log: dnbdr3$(EXEEXT)
@p='dnbdr3$(EXEEXT)'; \
b='dnbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr4.log: dnbdr4$(EXEEXT)
@p='dnbdr4$(EXEEXT)'; \
b='dnbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr5.log: dnbdr5$(EXEEXT)
@p='dnbdr5$(EXEEXT)'; \
b='dnbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dnbdr6.log: dnbdr6$(EXEEXT)
@p='dnbdr6$(EXEEXT)'; \
b='dnbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr1.log: dsbdr1$(EXEEXT)
@p='dsbdr1$(EXEEXT)'; \
b='dsbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr2.log: dsbdr2$(EXEEXT)
@p='dsbdr2$(EXEEXT)'; \
b='dsbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr3.log: dsbdr3$(EXEEXT)
@p='dsbdr3$(EXEEXT)'; \
b='dsbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr4.log: dsbdr4$(EXEEXT)
@p='dsbdr4$(EXEEXT)'; \
b='dsbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr5.log: dsbdr5$(EXEEXT)
@p='dsbdr5$(EXEEXT)'; \
b='dsbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsbdr6.log: dsbdr6$(EXEEXT)
@p='dsbdr6$(EXEEXT)'; \
b='dsbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr1.log: snbdr1$(EXEEXT)
@p='snbdr1$(EXEEXT)'; \
b='snbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr2.log: snbdr2$(EXEEXT)
@p='snbdr2$(EXEEXT)'; \
b='snbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr3.log: snbdr3$(EXEEXT)
@p='snbdr3$(EXEEXT)'; \
b='snbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr4.log: snbdr4$(EXEEXT)
@p='snbdr4$(EXEEXT)'; \
b='snbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr5.log: snbdr5$(EXEEXT)
@p='snbdr5$(EXEEXT)'; \
b='snbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
snbdr6.log: snbdr6$(EXEEXT)
@p='snbdr6$(EXEEXT)'; \
b='snbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr1.log: ssbdr1$(EXEEXT)
@p='ssbdr1$(EXEEXT)'; \
b='ssbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr2.log: ssbdr2$(EXEEXT)
@p='ssbdr2$(EXEEXT)'; \
b='ssbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr3.log: ssbdr3$(EXEEXT)
@p='ssbdr3$(EXEEXT)'; \
b='ssbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr4.log: ssbdr4$(EXEEXT)
@p='ssbdr4$(EXEEXT)'; \
b='ssbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr5.log: ssbdr5$(EXEEXT)
@p='ssbdr5$(EXEEXT)'; \
b='ssbdr5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssbdr6.log: ssbdr6$(EXEEXT)
@p='ssbdr6$(EXEEXT)'; \
b='ssbdr6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr1.log: znbdr1$(EXEEXT)
@p='znbdr1$(EXEEXT)'; \
b='znbdr1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr2.log: znbdr2$(EXEEXT)
@p='znbdr2$(EXEEXT)'; \
b='znbdr2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr3.log: znbdr3$(EXEEXT)
@p='znbdr3$(EXEEXT)'; \
b='znbdr3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
znbdr4.log: znbdr4$(EXEEXT)
@p='znbdr4$(EXEEXT)'; \
b='znbdr4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr6.f 0000644 0001750 0001750 00000023461 12277373057 013604 0000000 0000000 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 A*x = LAMBDA*M*x.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Double precision
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2 , dnrm2
external dlapy2 , dnrm2 , daxpy , dgbmv
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. Since the Cayley mode is |
c | used, WHICH is set to 'LM'. The user can |
c | modify N, NEV, NCV and SIGMA to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 150.0
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 5
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dble (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR6 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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,
& 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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dsband.f 0000644 0001750 0001750 00000077162 12277373057 013662 0000000 0000000 c \BeginDoc
c
c \Name: dsband
c
c \Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal (Lanczos) basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style band form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
c of n*nev if both are requested (in this case a separate array Z must be
c supplied).
c
c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
c are called Ritz values and Ritz vectors respectively. They are referred
c to as such in the comments that follow. The computed orthonormal basis
c for the invariant subspace corresponding to these Ritz values is referred
c to as a Lanczos basis.
c
c dsband can be called with one of the following modes:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 in DSAUPD)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c The choice of mode must be specified in IPARAM(7) defined below.
c
c \Usage
c call dsband
c ( RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, N, AB, MB, LDA,
c RFAC, KL, KU, WHICH, BMAT, NEV, TOL, RESID, NCV, V,
c LDV, IPARAM, WORKD, WORKL, LWORKL, IWORK, INFO )
c
c \Arguments
c
c RVEC Logical (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the associated Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
c = 'A': compute all Ritz vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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
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 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 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
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 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 If IPARAM(7) = 3,4,5 represents the shift. Not referenced if
c IPARAM(7) = 1 or 2.
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c AB Double precision 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 Double precision 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
c array AB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7) = 1
c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, RFAC.
c
c RFAC Double precision array of LDA by N. (WORKSPACE/OUTPUT)
c RFAC is used to store the LU factors of MB when IPARAM(7) = 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when IPARAM(7) = 3,4,5 is invoked.
c It is not referenced when IPARAM(7) = 1.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When IPARAM(7)= 1 or 2, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LA' -> want the NEV eigenvalues of largest REAL part.
c 'SA' -> want the NEV eigenvalues of smallest REAL part.
c 'BE' -> Compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from
c the high end than from the low end.
c
c When IPARAM(7) = 3, 4, or 5, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed.
c
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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c Represents the dimension of the Lanczos basis constructed
c by dsaupd for OP.
c
c V Double precision array N by NCV. (OUTPUT)
c Upon INPUT: the NCV columns of V contain the Lanczos basis
c vectors as constructed by dsaupd for OP.
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c represent the Ritz vectors that span the desired
c invariant subspace.
c NOTE: The array Z may be set equal to first NEV columns of the
c Lanczos basis vector array V computed by dsaupd. In this case
c if RVEC=.TRUE., the first NCONV=IPARAM(5) columns of V contain
c the desired Ritz vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ------------------------------------------------------------
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 dsband for the
c five modes available.
c
c IPARAM(8) = NP
c Not referenced.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c WORKD Double precision work array of length at least 3*n. (WORKSPACE)
c
c WORKL Double precision work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used when IPARAM(7)=2,3,4,5 to store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
c is to increase the size of NCV relative to NEV.
c See remark 4 in DSAUPD.
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 = -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 trid. eigenvalue calculation;
c Informational 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 = -13: HOWMNY must be one of 'A' or 'P'
c = -14: DSAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current
c Arnoldi factorization.
c
c \EndDoc
c
c------------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Routines called:
c dsaupd ARPACK reverse communication interface routine.
c dseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dgbtrf LAPACK band matrix factorization routine.
c dgbtrs LAPACK band linear system solve routine.
c dlacpy LAPACK matrix copy routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dcopy Level 1 BLAS that copies one vector to another.
c ddot Level 1 BLAS that computes the dot product of two vectors.
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\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c---------------------------------------------------------------------
c
subroutine dsband( rvec, howmny, select, d, z, ldz, sigma,
& n, ab, mb, lda, rfac, kl, ku, which, bmat, nev,
& tol, resid, ncv, v, ldv, iparam, workd, workl,
& lworkl, iwork, info)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character which*2, bmat, howmny
integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Double precision
& tol, sigma
logical rvec
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(*), iwork(*)
logical select(*)
Double precision
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), rfac(lda,*),
& workd(*), workl(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, type, imid, itop, ibot, ierr
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
Double precision
& ddot, dnrm2, dlapy2
external ddot, dcopy, dgbmv, dgbtrf,
& dgbtrs, dnrm2, dlapy2, dlacpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------------------%
c | Set type of the problem to be solved. Check consistency |
c | between BMAT and IPARAM(7). |
c | type = 1 --> Solving standard problem in regular mode. |
c | type = 2 --> Solving standard problem in shift-invert mode. |
c | type = 3 --> Solving generalized problem in regular mode. |
c | type = 4 --> Solving generalized problem in shift-invert mode. |
c | type = 5 --> Solving generalized problem in Buckling mode. |
c | type = 6 --> Solving generalized problem in Cayley mode. |
c %----------------------------------------------------------------%
c
if ( iparam(7) .eq. 1 ) then
type = 1
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'I') then
type = 2
else if ( iparam(7) .eq. 2 ) then
type = 3
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'G') then
type = 4
else if ( iparam(7) .eq. 4 ) then
type = 5
else if ( iparam(7) .eq. 5 ) then
type = 6
else
print*, ' '
print*, 'BMAT is inconsistent with IPARAM(7).'
print*, ' '
go to 9000
end if
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( type .eq. 2 .or. type .eq. 6 .and. bmat .eq. 'I' ) then
c
c %----------------------------------%
c | Solving a standard eigenvalue |
c | problem in shift-invert or |
c | Cayley mode. Factor (A-sigma*I). |
c %----------------------------------%
c
call dlacpy ('A', ibot, n, ab, lda, rfac, lda )
do 10 j = 1, n
rfac(imid,j) = ab(imid,j) - sigma
10 continue
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr )
if (ierr .ne. 0) then
print*, ' '
print*, ' _SBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %----------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | regular mode. Copy M to rfac and Call LAPACK |
c | routine dgbtrf to factor M. |
c %----------------------------------------------%
c
call dlacpy ('A', ibot, n, mb, lda, rfac, lda )
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_SBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 .or. type .eq. 5 .or. type .eq. 6
& .and. bmat .eq. 'G' ) then
c
c %-------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | shift-invert, Buckling, or Cayley mode. |
c %-------------------------------------------%
c
c %-------------------------------------%
c | Construct and factor (A - sigma*M). |
c %-------------------------------------%
c
do 60 j = 1,n
do 50 i = itop, ibot
rfac(i,j) = ab(i,j) - sigma*mb(i,j)
50 continue
60 continue
c
call dgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_SBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
90 continue
c
call dsaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2 ) then
c
c %----------------------------------%
c | Perform |
c | y <--- OP*x = inv[A-sigma*I]*x |
c | to force the starting vector |
c | into the range of OP. |
c %----------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _bgtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | to force the starting vector into |
c | the range of OP. |
c %-----------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call dcopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*M |
c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 5) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*A |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call dgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 6 ) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = (inv[A-SIGMA*M])*(A+SIGMA*M)*x |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
if ( bmat .eq. 'G' ) then
call dgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
call dgbmv('Notranspose', n, n, kl, ku, sigma,
& mb(itop,1), lda, workd(ipntr(1)), 1,
& one, workd(ipntr(2)), 1)
else
call dcopy(n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, sigma,
& workd(ipntr(2)), 1)
end if
c
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
else if (ido .eq. 1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2) then
c
c %----------------------------------%
c | Perform |
c | y <--- OP*x = inv[A-sigma*I]*x. |
c %----------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
call dcopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %-------------------------------------%
c
call dcopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_SBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 5 ) then
c
c %-------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*A*x |
c | B*x = A*x has been computed |
c | and saved in workd(ipntr(3)). |
c %-------------------------------%
c
call dcopy (n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _SBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
else if ( type .eq. 6) then
c
c %---------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*(A+SIGMA*M)*x. |
c | (M*x) has been saved in |
c | workd(ipntr(3)). |
c %---------------------------------%
c
if ( bmat .eq. 'G' ) then
call dgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
call daxpy( n, sigma, workd(ipntr(3)), 1,
& workd(ipntr(2)), 1 )
else
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call dgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, sigma,
& workd(ipntr(2)), 1)
end if
call dgbtrs('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
c
end if
c
else if (ido .eq. 2) then
c
c %----------------------------------%
c | Perform y <-- B*x |
c | Note when Buckling mode is used, |
c | B = A, otherwise B=M. |
c %----------------------------------%
c
if (type .eq. 5) then
c
c %---------------------%
c | Buckling Mode, B=A. |
c %---------------------%
c
call dgbmv('Notranspose', n, n, kl, ku, one,
& ab(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
else
call dgbmv('Notranspose', n, n, kl, ku, one,
& mb(itop,1), lda, workd(ipntr(1)), 1,
& zero, workd(ipntr(2)), 1)
end if
c
else
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-----------------------------------------%
c
if ( info .lt. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
go to 9000
c
else
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
if (iparam(5) .gt. 0) then
c
call dseupd ( rvec, 'A', select, d, z, ldz, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of dneupd. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
go to 9000
c
end if
c
end if
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %----------------------------------------%
c
go to 90
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr6.f 0000644 0001750 0001750 00000031632 12277373057 013576 0000000 0000000 program dnbdr6
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
c diagonal block is a tridiagonal matrix with
c 4 on the diagonal, 1-rho*h/2 on the subdiagonal and
c 1+rho*h/2 on the superdiagonal. Each subdiagonal block
c of A is an identity matrix. The matrix M is the
c tridiagonal matrix with 4 on the diagonal and 1 on the
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 such that
c A*x = LAMBDA*M*x.
c
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
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr6.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c---------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
parameter (one = 1.0D+0 , zero = 0.0D+0 ,
& two = 2.0D+0 )
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2 , dnrm2
external dlapy2 , dnrm2 , dgbmv , daxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-----------------------------------------------------%
c | The number NX is the size of each diagonal block of |
c | A. The number N(=NX*NX) is the dimension of the |
c | matrix. The number N(=NX*NX) is the dimension of |
c | the matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV numbers of eigenvalues |
c | closest to the COMPLEX shift (SIGMAR,SIGMAI) |
c | (WHICH='LM') and their corresponding eigenvectors |
c | are computed. The user can modify NX, NEV, NCV, |
c | WHICH to solve problems of different sizes, and |
c | to get different parts the spectrum. However, the |
c | following rules must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigmar = 4.0D-1
sigmai = 6.0D-1
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0D+0
m(idiag,j) = 4.0D+0
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+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
a(isub,j+1) = -one+h*rho/two
a(isup,j) = -one-h*rho/two
40 continue
50 continue
c
do 60 j = 1, n-1
m(isub,j+1) = one
m(isup,j) = one
60 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one
a(isub,j) = -one
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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, workev, n, a, m, lda, rfac, cfac, ku, kl,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR6 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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,
& 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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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,
& 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,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& 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,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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr3.f 0000644 0001750 0001750 00000023225 12277373057 013616 0000000 0000000 program ssbdr3
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 SSBAND with regular mode to find eigenvalues LAMBDA
c such that
c A*x = LAMBDA*M*x.
c
c ... Use mode 2 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Real
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 2 of SSAUPD is used |
c | (IPARAM(7) = 2). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 2
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR3 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr5.f 0000644 0001750 0001750 00000023363 12277373057 013623 0000000 0000000 program ssbdr5
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 SSBAND with Buckling mode to find eigenvalues LAMBDA
c such that
c A*x = M*x*LAMBDA.
c
c ... Use mode 4 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn), mx(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, j, ido,
& n, isub, isup, idiag, maxitr, mode, nconv
Real
& tol, h, sigma, r1, r2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
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 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. Since the Buckling mode is |
c | is used, WHICH is set to 'LM'. The user can |
c | modify N, NEV, NCV and SIGMA to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 1.0
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 4 of SSAUPD is used |
c | (IPARAM(7) = 4). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / real (n+1)
r1 = four / six
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = r1 * h
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
r2 = one / six
isup = kl+ku
isub = kl+ku+2
do 60 j = 1, n-1
a(isup,j+1) = -one / h
a(isub,j) = -one / h
m(isup,j+1) = r2 * h
m(isub,j) = r2 * h
60 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR5 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& m(kl+1,1), lda, v(1,j), 1, zero,
& mx, 1)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/znband.f 0000644 0001750 0001750 00000055314 12277373057 013676 0000000 0000000 c \BeginDoc
c
c \Name: znband
c
c \Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style banded form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
c
c The approximate eigenvalues and eigenvectors of A*z = lambda*B*z
c are 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 Schur basis.
c
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.
c
c Mode 2: A*z = lambda*M*z, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c
c Mode 3: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = inv[A - sigma*M]*M and B = M.
c ===> shift-and-invert mode.
c
c Choice of different modes can be specified in IPARAM(7) defined below.
c
c \Usage
c call znband
c ( RVEC, HOWMNY, SELECT, D , Z, LDZ, SIGMA, WORKEV, N, AB,
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
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the invariant subspace to be computed
c corresponding to the converged Ritz values.
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
c computed. To select the real Ritz vector corresponding to a
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 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 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
c A*z = lambda*B*z.
c
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 columns of the
c array V.
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 ) is required.
c In any case, LDZ .ge. 1 is required.
c
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
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
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 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
c array MB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7)=1.
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 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.
c It is not referenced when IPARAM(7)=1.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When mode 1,2 are used, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 When mode 3 is used, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
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 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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then
c the first NCONV=IPARAM(5) columns of V will contain Ritz vectors
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. LDV must be great than or equal to N.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ----------------------------------------------------------
c ISHIFT = 1: exact shift with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c -------------------------------------------------------------
c
c IPARAM(2) = Not referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c
c IPARAM(6) = IUPD
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 three modes available.
c
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
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
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used to mode 2,3. Store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
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 accuracy.
c
c \EndDoc
c
c------------------------------------------------------------------------
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 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
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,
& workev, n, ab, mb, lda, fac, kl, ku, which,
& bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, rwork, iwork, info )
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
Character which*2, bmat, howmny
Logical rvec
Integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Complex*16
& sigma
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Integer iparam(*), iwork(*)
Logical select(*)
Complex*16
& d(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), fac(lda,*),
& workd(*), workl(*), workev(*)
Double precision
& rwork(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, mode, ierr, itop, imid, ibot
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
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
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
mode = iparam(7)
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( mode .eq. 2 ) then
c
c %-----------------------------------------------%
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)
if (ierr .ne. 0) then
print*, ' '
print*,'_band: error in _gbtrf'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
if (bmat .eq. 'I') then
c
c %-------------------------%
c | Construct (A - sigma*I) |
c %-------------------------%
c
call zlacpy ('A', ibot, n, ab, lda, fac, lda )
do 10 j = 1,n
fac(imid,j) = ab(imid,j) - sigma
10 continue
c
else
c
c %---------------------------%
c | Construct (A - sigma*M) |
c %---------------------------%
c
do 30 j = 1,n
do 20 i = itop, ibot
fac(i,j) = ab(i,j) - sigma*mb(i,j)
20 continue
30 continue
c
end if
c
c %------------------------%
c | Factor (A - sigma*M) |
c %------------------------%
c
call zgbtrf (n, n, kl, ku, fac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_band: error in _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
40 continue
c
call znaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork,info )
c
if (ido .eq. -1) then
c
if ( mode .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( mode .eq. 2 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
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,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = inv[A-SIGMA*M]*M* x
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),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call zgbtrs ('Notranspose', n, kl, ku, 1, fac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
else if (ido .eq. 1) then
c
if ( mode .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call zgbmv ('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( mode .eq. 2 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
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,
& iwork, workd(ipntr(2)), ldv, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in sbgtrs.'
print*, ' '
go to 9000
end if
c
else if ( mode .eq. 3 ) then
c
if ( bmat .eq. 'I' ) then
c
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,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
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,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_band: error in _gbtrs.'
print*, ' '
go to 9000
end if
c
end if
c
endif
c
else if (ido .eq. 2) then
c
c %--------------------%
c | Perform y <-- M*x |
c %--------------------%
c
call zgbmv ('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else
c
c %-------------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-------------------------------------------%
c
if ( info .ne. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in dnaupd |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd '
print *, ' '
c
else
c
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)
c
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of zneupd . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
c
endif
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call znaupd again. |
c %----------------------------------------%
c
go to 40
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/BAND/dnbdr3.f 0000644 0001750 0001750 00000027737 12277373057 013606 0000000 0000000 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
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 A*x = LAMBDA*M*x.
c
c ... Eigenvalues with largest real parts are sought.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr3.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j, ido,
& n, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Double precision
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved |
c | (BMAT = 'G'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify N, NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %----------------------------------------------------%
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 |
c | precision is used. The number IDO is used for |
c | reverse communication and has to be set to 0 at |
c | the beginning. Setting INFO=0 indicates that we |
c | using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
info = 0
tol = zero
ido = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
mode = 2
maxitr = 300
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0D+1
do 50 j = 1, n
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
50 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
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, workev, n, A, M, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv, iparam,
& workd, workl, lworkl, workc, iwork, info)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR3 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
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,
& 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)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
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,
& 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,
& 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,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& 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,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))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/znbdr4.f 0000644 0001750 0001750 00000024627 12277373057 013630 0000000 0000000 program zndrv4
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matries A and M are derived from the finite
c element discretization of the 1-dimensional
c convection-diffusion operator
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 A*x = M*x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j,
& n, idiag, isup, isub, maxitr, mode,
& nconv
logical rvec
Double precision
& tol
Complex*16
& rho, h, sigma
c
c %------------%
c | Parameters |
c %------------%
c
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 , zlaset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV is the number of |
c | eigenvalues (closest to the shift SIGMA) to be |
c | approximated. Since the shift and invert mode |
c | is used, WHICH is set to 'LM'. The user can |
c | modify NX, NEV and NCV to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = (1.0D+1, 0.0D+0)
c
c %----------------------------------------------------%
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 |
c | precision is used. Setting INFO=0 indicates that |
c | we using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
info = 0
tol = 0.0
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / dcmplx (n+1)
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = two / h
m(idiag,j) = four * h / six
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
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 / six
m(isub,j) = one*h / six
40 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR4 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
do 90 j = 1, nconv
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
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,
& 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))
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/dsbdr2.f 0000644 0001750 0001750 00000024312 12277373057 013574 0000000 0000000 program dsbdr2
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-dimensional Laplacian on the unit square
c with zero Dirichlet boundary condition using standard
c central difference.
c
c ... Call DSBAND to find eigenvalues LAMBDA closest to
c SIGMA such that
c A*x = x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
Double precision
& a(lda,maxn), m(lda,maxn), rfac(lda,maxn),
& workl(3*maxncv*maxncv+6*maxncv), workd(3*maxn),
& v(ldv, maxncv), resid(maxn), d(maxncv, 2),
& ax(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
Double precision
& tol, sigma, h2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero, two
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
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian operator on the unit square with zero |
c | Dirichlet boundary condition. The number |
c | N(=NX*NX) is the dimension of the matrix. A |
c | standard eigenvalue problem is solved |
c | (BMAT = 'I'). NEV is the number of eigenvalues |
c | (closest to the shift SIGMA) to be approximated. |
c | Since the shift and invert mode is used, WHICH |
c | is set to 'LM'. The user can modify NX, NEV, |
c | NCV and SIGMA to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 in |
c | DSBAND . |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0D+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one / h2
a(isub,j) = -one / h2
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-------------------------------------%
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 |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR2 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
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)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/cnbdr2.f 0000644 0001750 0001750 00000025205 12277373057 013570 0000000 0000000 program cnbdr2
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
c ... Call CNBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
c ... Use mode 3 of CNAUPD.
c
c\BeginLib
c
c cnband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c claset LAPACK routine to initialize a matrix to zero.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c cgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr2.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, i, j,
& n, nxi, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
Real
& tol
Complex
& rho, h, h2, 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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to SIGMA) to be |
c | approximated. Since the shift and invert mode |
c | is used, WHICH is set to 'LM'. The user can |
c | modify NX, NEV and NCV to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, the following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nxi = 10
n = nxi*nxi
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigma = zero
c
c %-----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 CNAUPD to start the |
c | Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of CNAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
c | in cnband. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nxi
ku = nxi
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / cmplx(nxi+1)
h2 = h*h
c
idiag = kl+ku+1
do 30 j = 1, n
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)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nxi
lo = (i-1)*nxi
do 40 j = lo+1, lo+nxi-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nxi-1
lo = (i-1)*nxi
do 70 j = lo+1, lo+nxi
a(isup,nxi+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
call cnband(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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR2 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one,
& 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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1),rd(j,2))
90 continue
call smout(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 cnband. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/ssbdr1.f 0000644 0001750 0001750 00000024103 12277373057 013610 0000000 0000000 program ssbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition using standard
c central difference.
c
c ... Call SSBAND to find eigenvalues LAMBDA such that
c A*x = x*LAMBDA.
c
c ... Use mode 1 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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),
& ax(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
Real
& tol, sigma, h2
logical rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 , two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian operator on the unit square with zero |
c | Dirichlet boundary condition. The number |
c | N(=NX*NX) is the dimension of the matrix. A |
c | standard eigenvalue problem is solved |
c | (BMAT = 'I'). NEV is the number of eigenvalues |
c | to be approximated. The user can modify NX,NEV, |
c | NCV and WHICH to solve problems of different |
c | sizes, and to get different parts the spectrum. |
c | However, the following conditions must be |
c | satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 1 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv**2+8*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 1 of SSAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h2 = one / ((nx+1)*(nx+1))
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0E+0 / h2
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one / h2
a(isub,j) = -one / h2
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-------------------------------------%
c | Call SSBAND to find eigenvalues and |
c | eigenvectors. Eigenvalues are |
c | returned in the first column of D. |
c | Eigenvectors are returned in the |
c | first NCONV (=IPARAM(5)) columns of |
c | V. |
c %-------------------------------------%
c
rvec = .true.
call ssband( 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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, ' _SBDR1 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Lanczos vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
90 continue
call smout(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 SSBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _sband, info= ', info
print *, ' Check the documentation of _sband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr2.f 0000644 0001750 0001750 00000027701 12277373057 013613 0000000 0000000 program snbdr2
c
c ... Construct matrices A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
c ... Define the shift SIGMA = (SIGMAR, SIGMAI).
c
c ... Call SNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*x.
c
c ... Use mode 3 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr2.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c---------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isub, isup, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h2, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 ,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, saxpy, sgbmv
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to (SIGMAR,SIGMAI)) to be |
c | approximated. Since the shift-invert moded is |
c | used, WHICH is set to 'LM'. The user can modify |
c | NX, NEV, NCV, SIGMAR, SIGMAI to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR2: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 1.0E+4
sigmai = 0.0E+0
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 3 of SNAUPD is used |
c | (IPARAM(7) = 3). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SNBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 3
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
rho = 1.0E+1
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isub,j+1) = -one/h2 + rho/two/h
a(isup,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband(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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR2 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
call smout(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 SNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr5.f 0000644 0001750 0001750 00000027636 12277373057 013625 0000000 0000000 program snbdr5
c
c ... Construct matrices A and M in LAPACK-style band form.
c The matrix A is a block tridiagonal matrix. Each
c diagonal block is a tridiagonal matrix with
c 4 on the diagonal, 1-rho*h/2 on the subdiagonal and
c 1+rho*h/2 on the superdiagonal. Each off-diagonal block
c of A is an identity matrices.
c
c ... Define COMPLEX shift SIGMA = (SIGMAR,SIGMAI), SIGMAI .ne. 0.
c
c ... Call SNBAND to find eigenvalues LAMBDA closest to SIGMA
c such that
c A*x = LAMBDA*x.
c
c ... Use mode 4 of SNAUPD.
c
c\BeginLib
c
c\Routines called:
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr5.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, idiag, isup, isub, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 ,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number NX is the size of each block diagonal |
c | of A. The number N(=NX*NX) is the dimension of |
c | the matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues (closest to (SIGMAR,SIGMAI)) to be |
c | approximated. Since the shift-invert moded is |
c | used, WHICH is set to 'LM'. The user can modify |
c | NX, NEV, NCV, SIGMAR, SIGMAI to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
sigmar = 4.0E-1
sigmai = 6.0E-1
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 4 of SNAUPD is used |
c | (IPARAM(7) = 4). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SNBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 4
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
idiag = kl+ku+1
do 30 j = 1, n
a(idiag,j) = 4.0E+0
m(idiag,j) = 4.0E+0
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+kl+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
a(isup,j+1) = -one+h*rho/two
a(isub,j) = -one-h*rho/two
40 continue
50 continue
c
do 60 j = 1, n-1
m(isup,j+1) = one
m(isub,j) = one
60 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one
a(isub,j) = -one
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband(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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR5 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
call smout(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 SNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/znbdr1.f 0000644 0001750 0001750 00000025101 12277373057 013611 0000000 0000000 program znbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
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 A*x = x*LAMBDA.
c
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr1.F SID: 2.3 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, kl, ku, info, i, j,
& n, nx, lo, isub, isup, idiag, maxitr, mode,
& nconv
logical rvec
Double precision
& tol
Complex*16
& rho, h, h2, 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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dznrm2 , dlapy2
external dznrm2 , zgbmv , zaxpy , dlapy2 , zlaset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV and WHICH to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, the following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %-----------------------------------------------------%
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 | Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
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 %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
rho = (1.0D+2, 0.0D+0)
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR1 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
do 90 j = 1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | || A*x - lambda*x || |
c %---------------------------%
c
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))
90 continue
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 %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/cnbdr3.f 0000644 0001750 0001750 00000024273 12277373057 013575 0000000 0000000 program cnbdr3
c
c ... Construct matrices A and M in LAPACK-style band form.
c Matrices A and M are derived from the finite
c element discretization of the 1-dimensional
c convection-diffusion operator
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 CNBAND 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 CNAUPD.
c
c\BeginLib
c
c\Routines called:
c cnband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c claset LAPACK routine to initialize a matrix to zero.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c scnrm2 Level 1 BLAS that computes the norm of a vector.
c cgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr3.F SID: 2.4 DATE OF SID: 10/20/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-------------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& rwork(maxn), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, j,
& n, idiag, isup, isub, maxitr,
& mode, nconv
logical rvec
Real
& tol
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) )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& scnrm2, slapy2
external scnrm2, cgbmv, caxpy, slapy2, claset
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A generalized eigenvalue problem is |
c | solved (BMAT = 'G'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV and WHICH to solve problems |
c | of different sizes, and to get different parts |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %----------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 |
c | precision is used. Setting INFO=0 indicates that |
c | using a randomly generated vector to start the |
c | the ARNOLDI process. |
c %----------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
info = 0
tol = 0.0
c
c %---------------------------------------------------%
c | IPARAm(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 2 of CNAUPD is used |
c | (IPARAm(7) = 2). All these options can be changed |
c | by the user. For details, see the documentation |
c | in cnband. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 2
c
iparam(3) = maxitr
iparam(7) = mode
c
c %--------------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = 1
ku = 1
c
c %---------------%
c | Main diagonal |
c %---------------%
c
h = one / cmplx(n+1)
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
isup = kl+ku
isub = kl+ku+2
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
40 continue
c
c %-----------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. Eigenvalues are returned in |
c | the one dimensional array D. Eigenvectors |
c | are returned in the first NCONV (=IPARAM(5)) |
c | columns of V. |
c %-----------------------------------------------%
c
rvec = .true.
call cnband(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)
c
if ( info .eq. 0) then
c
nconv = iparam(5)
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
print *, ' '
print *, '_NBDR3 '
print *, '====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
do 50 j = 1, nconv
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
call cgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call cgbmv('Notranspose', n, n, kl, ku, one,
& 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,2) = aimag(d(j))
rd(j,3) = scnrm2(n, ax, 1)
rd(j,3) = rd(j,3) / slapy2(rd(j,1), rd(j,2))
50 continue
call smout(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 cnband. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _band, info= ', info
print *, ' Check the documentation of _band '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snbdr1.f 0000644 0001750 0001750 00000027336 12277373057 013616 0000000 0000000 program snbdr1
c
c ... Construct the matrix A in LAPACK-style band form.
c The matrix A is derived from the discretization of
c the 2-d convection-diffusion operator
c
c -Laplacian(u) + rho*partial(u)/partial(x).
c
c on the unit square with zero Dirichlet boundary condition
c using standard central difference.
c
c ... Call SNBAND to find eigenvalues LAMBDA such that
c A*x = LAMBDA*x.
c
c ... Use mode 1 of SNAUPD.
c
c\BeginLib
c
c snband ARPACK banded eigenproblem solver.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK routine to initialize a matrix to zero.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nbdr1.F SID: 2.5 DATE OF SID: 08/26/96 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c----------------------------------------------------------------------
c
c %-------------------------------------%
c | Define leading dimensions for all |
c | arrays. |
c | MAXN - Maximum size of the matrix |
c | MAXNEV - Maximum number of |
c | eigenvalues to be computed |
c | MAXNCV - Maximum number of Arnoldi |
c | vectors stored |
c | MAXBDW - Maximum bandwidth |
c %-------------------------------------%
c
integer maxn, maxnev, maxncv, maxbdw, lda,
& lworkl, ldv
parameter ( maxn = 1000, maxnev = 25, maxncv=50,
& maxbdw=50, lda = maxbdw, ldv = maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), iwork(maxn)
logical select(maxncv)
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
& cfac(lda, maxn), workc(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character which*2, bmat
integer nev, ncv, ku, kl, info, i, j, ido,
& n, nx, lo, isub, isup, idiag, mode, maxitr,
& nconv
logical rvec, first
Real
& tol, rho, h, h2, sigmar, sigmai
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero, two
parameter (one = 1.0E+0 , zero = 0.0E+0 ,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2, sgbmv, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts the |
c | spectrum. However, The following conditions |
c | must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %-------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _NBDR1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NBDR1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NBDR1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | IPARAM(3) specifies the maximum number of Arnoldi |
c | iterations allowed. Mode 1 of SNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details, see the documentation |
c | in SNBAND. |
c %---------------------------------------------------%
c
maxitr = 300
mode = 1
c
iparam(3) = maxitr
iparam(7) = mode
c
c %----------------------------------------%
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 |
c | matrices A and M. |
c %-------------------------------------%
c
kl = nx
ku = nx
c
c %---------------%
c | Main diagonal |
c %---------------%
c
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
30 continue
c
c %-------------------------------------%
c | First subdiagonal and superdiagonal |
c %-------------------------------------%
c
rho = 1.0E+2
isup = kl+ku
isub = kl+ku+2
do 50 i = 1, nx
lo = (i-1)*nx
do 40 j = lo+1, lo+nx-1
a(isup,j+1) = -one/h2 + rho/two/h
a(isub,j) = -one/h2 - rho/two/h
40 continue
50 continue
c
c %------------------------------------%
c | KL-th subdiagonal and KU-th super- |
c | diagonal. |
c %------------------------------------%
c
isup = kl+1
isub = 2*kl+ku+1
do 80 i = 1, nx-1
lo = (i-1)*nx
do 70 j = lo+1, lo+nx
a(isup,nx+j) = -one / h2
a(isub,j) = -one / h2
70 continue
80 continue
c
c %------------------------------------------------%
c | Call ARPACK banded solver to find eigenvalues |
c | and eigenvectors. The real parts of the |
c | eigenvalues are returned in the first column |
c | of D, the imaginary parts are returned in the |
c | second column of D. Eigenvectors are returned |
c | in the first NCONV (=IPARAM(5)) columns of V. |
c %------------------------------------------------%
c
rvec = .true.
call snband(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)
c
if ( info .eq. 0) then
c
c %-----------------------------------%
c | Print out convergence information |
c %-----------------------------------%
c
nconv = iparam(5)
c
print *, ' '
print *, ' _NBDR1 '
print *, ' ====== '
print *, ' '
print *, ' The size of the matrix is ', n
print *, ' Number of eigenvalue requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' What portion of the spectrum ', which
print *, ' The number of Implicit Arnoldi ',
& ' update taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence tolerance is ', tol
print *, ' '
c
c %----------------------------%
c | Compute the residual norm. |
c | || A*x - lambda*x || |
c %----------------------------%
c
first = .true.
do 90 j = 1, nconv
c
if ( d(j,2) .eq. zero ) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
d(j,3) = d(j,3) / abs(d(j,1))
c
else if ( first ) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j), 1, zero,
& ax, 1)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(n, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = snrm2(n, ax, 1)
call sgbmv('Notranspose', n, n, kl, ku, one,
& a(kl+1,1), lda, v(1,j+1), 1, zero,
& ax, 1)
call saxpy(n, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(n, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2( d(j,3), snrm2(n, ax, 1) )
d(j,3) = d(j,3) / slapy2(d(j,1),d(j,2))
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
90 continue
call smout(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 SNBAND. |
c %-------------------------------------%
c
print *, ' '
print *, ' Error with _nband, info= ', info
print *, ' Check the documentation of _nband '
print *, ' '
c
end if
c
9000 end
arpack-ng-3.1.5/EXAMPLES/BAND/snband.f 0000644 0001750 0001750 00000145110 12277373057 013661 0000000 0000000 c \BeginDoc
c
c \Name: snband
c
c \Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c Matrices A and B are stored in LAPACK-style banded form.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
c
c The 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 snband can be called with one of the following modes:
c
c Mode 1: A*z = lambda*z.
c ===> OP = A and B = I.
c
c Mode 2: A*z = lambda*M*z, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c
c Mode 3: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*z = amu*z, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*z = lambda*M*z, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*z = amu*z, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c
c The choice of mode must be specified in IPARAM(7) defined below.
c
c \Usage
c call snband
c ( RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, V, N, AB, MB, LDA, RFAC, CFAC, KL, KU, WHICH,
c BMAT, NEV, TOL, RESID, NCV, V, LDV, IPARAM, WORKD,
c WORKL, LWORKL, WORKC, IWORK, INFO )
c
c \Arguments
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 On exit, DR contains the real part of the Ritz value approximations
c to the eigenvalues of A*z = lambda*B*z.
c
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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 On exit,
c 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
c A*z = lambda*B*z computed by SNAUPD.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 SNAUPD. 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 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 If IPARAM(7) = 3 or 4, represents the imaginary part of the
c shift.
c Not referenced if IPARAM(7) = 1 or 2.
c
c WORKEV Real work array of dimension 3*NCV. (WORKSPACE)
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c AB Real 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 Real 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
c array AB as follows:
c MB(kl+ku+1+i-j,j) = M(i,j) for max(1,j-ku)<=i<=min(m,j+kl)
c Not referenced if IPARAM(7) = 1
c
c LDA Integer. (INPUT)
c Leading dimension of AB, MB, RFAC and CFAC.
c
c RFAC Real array of LDA by N. (WORKSPACE/OUTPUT)
c RFAC is used to store the LU factors of MB when IPARAM(7) = 2
c is invoked. It is used to store the LU factors of
c (A-sigma*M) when IPARAM(7) = 3 is invoked with a real shift.
c It is not referenced when IPARAM(7) = 1 or 4.
c
c CFAC Complex array of LDA by N. (WORKSPACE/OUTPUT)
c CFAC is used to store (A-SIGMA*M) and its LU factors
c when IPARAM(7) = 3 or 4 are used with a complex shift SIGMA.
c On exit, it contains the LU factors of (A-SIGMA*M).
c It is not referenced when IPARAM(7) = 1 or 2.
c
c KL Integer. (INPUT)
c Max(number of subdiagonals of A, number of subdiagonals of M)
c
c KU Integer. (OUTPUT)
c Max(number of superdiagonals of A, number of superdiagonals of M)
c
c WHICH Character*2. (INPUT)
c When IPARAM(7)= 1 or 2, WHICH can be set to any one of
c the following.
c
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 When IPARAM(7) = 3 or 4, WHICH should be set to 'LM' only.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*z = lambda*z
c BMAT = 'G' -> generalized eigenvalue problem A*z = lambda*M*z
c NEV Integer. (INPUT)
c Number of eigenvalues to be computed.
c
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 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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c Represents the dimension of the Arnoldi basis constructed
c by snaupd for OP.
c
c V Real array N by NCV+1. (OUTPUT)
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c represent approximate Schur vectors that span the
c desired invariant subspace.
c NOTE: The array Z may be set equal to first NEV+1 columns of the
c Arnoldi basis vector array V computed by SNAUPD. In this case
c if RVEC = .TRUE. and HOWMNY='A', then the first NCONV=IPARAM(5)
c are the desired Ritz vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT:
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c It is set to 1 in this subroutine. The user do not need
c to set this parameter.
c ----------------------------------------------------------
c ISHIFT = 1: exact shift with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: max number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" eigenvalues.
c
c IPARAM(6) = IUPD
c Not referenced. Implicit restarting is ALWAYS used.
c
c IPARAM(7) = IPARAM(7):
c On INPUT determines what type of eigenproblem is being solved.
c Must be 1,2,3,4; See under \Description of snband for the
c four modes available.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*z operations,
c NUMOPB = total number of B*z operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c WORKD Real work array of length at least 3*n. (WORKSPACE)
c
c WORKL Real work array of length LWORKL. (WORKSPACE)
c
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c WORKC Complex array of length N. (WORKSPACE)
c Workspace used when IPARAM(7) = 3 or 4 for storing a temporary
c complex vector.
c
c IWORK Integer array of dimension at least N. (WORKSPACE)
c Used when IPARAM(7)=2,3,4 to store the pivot information in the
c factorization of M or (A-SIGMA*M).
c
c INFO Integer. (INPUT/OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = 1: The Schur form computed by LAPACK routine slahqr
c could not be reordered by LAPACK routine strsen.
c Re-enter subroutine SNEUPD with IPARAM(5)=NCV and
c increase the size of the arrays DR and DI to have
c dimension at least NCV and allocate at least NCV
c columns for Z. NOTE: Not necessary if Z and V share
c the same space. Please notify the authors.
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 = -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 slahqr.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine strevc.
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'
c = -14: SNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: Overflow occurs when we try to transform the Ritz
c values returned from SNAUPD to those of the original
c problem using Rayleigh Quotient.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current
c Arnoldi factorization.
c
c \EndDoc
c
c------------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Ph.D thesis, TR95-13, Rice Univ,
c May 1995.
c
c\Routines called:
c snaupd ARPACK reverse communication interface routine.
c sneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgbtrf LAPACK band matrix factorization routine.
c sgbtrs LAPACK band linear system solve routine.
c cgbtrf LAPACK complex band matrix factorization routine.
c cgbtrs LAPACK complex linear system solve routine.
c slacpy LAPACK matrix copy routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slamch LAPACK routine to compute the underflow threshold.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the dot product of two vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sgbmv Level 2 BLAS that computes the band matrix vector product.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
c Ritz values are stored on the diagonal of T.
c
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nband.F SID: 2.3 DATE OF SID: 10/17/00 RELEASE: 2
c
c\EndLib
c
c---------------------------------------------------------------------
c
subroutine snband( rvec, howmny, select, dr, di, z, ldz, sigmar,
& sigmai, workev, n, ab, mb, lda, rfac, cfac, kl, ku,
& which, bmat, nev, tol, resid, ncv, v, ldv,
& iparam, workd, workl, lworkl, workc, iwork, info)
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
character which*2, bmat, howmny
integer n, lda, kl, ku, nev, ncv, ldv,
& ldz, lworkl, info
Real
& tol, sigmar, sigmai
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(*), iwork(*)
logical select(*)
Real
& dr(*), di(*), resid(*), v(ldv,*), z(ldz,*),
& ab(lda,*), mb(lda,*), rfac(lda,*),
& workd(*), workl(*), workev(*)
Complex
& cfac(lda,*), workc(*)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer ipntr(14)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer ido, i, j, type, imid, itop, ibot, ierr
Real
& numr, denr, deni, dmdul, safmin
logical rvec, first
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c
c %-----------------------------%
c | LAPACK & BLAS routines used |
c %-----------------------------%
c
Real
& sdot, snrm2, slapy2, slamch
external sdot, scopy, sgbmv, cgbtrf, cgbtrs, sgbtrf,
& sgbtrs, snrm2, slapy2, slacpy, slamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
Intrinsic real, aimag, cmplx
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = slamch('safmin')
c
c %----------------------------------------------------------------%
c | Set type of the problem to be solved. Check consistency |
c | between BMAT and IPARAM(7). |
c | type = 1 --> Solving standard problem in regular mode. |
c | type = 2 --> Solving standard problem in shift-invert mode. |
c | type = 3 --> Solving generalized problem in regular mode. |
c | type = 4 --> Solving generalized problem in shift-invert mode. |
c | type = 5 --> Solving standard problem in shift-invert mode |
c | using iparam(7) = 4 in SNAUPD. |
c | type = 6 --> Solving generalized problem in shift-invert mode. |
c | using iparam(7) = 4 in SNAUPD. |
c %----------------------------------------------------------------%
c
if ( iparam(7) .eq. 1 ) then
type = 1
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'I') then
type = 2
else if ( iparam(7) .eq. 2 ) then
type = 3
else if ( iparam(7) .eq. 3 .and. bmat .eq. 'G') then
type = 4
else if ( iparam(7) .eq. 4 .and. bmat .eq. 'I') then
type = 5
else if ( iparam(7) .eq. 4 .and. bmat .eq. 'G') then
type = 6
else
print*, ' '
print*, 'BMAT is inconsistent with IPARAM(7).'
print*, ' '
go to 9000
end if
c
c %----------------------------------%
c | When type = 5,6 are used, sigmai |
c | must be nonzero. |
c %----------------------------------%
c
if ( type .eq. 5 .or. type .eq. 6 ) then
if ( sigmai .eq. zero ) then
print*, ' '
print*, '_NBAND: sigmai must be nonzero when type 5 or 6
& is used. '
print*, ' '
go to 9000
end if
end if
c
c %------------------------%
c | Initialize the reverse |
c | communication flag. |
c %------------------------%
c
ido = 0
c
c %----------------%
c | Exact shift is |
c | used. |
c %----------------%
c
iparam(1) = 1
c
c %-----------------------------------%
c | Both matrices A and M are stored |
c | between rows itop and ibot. Imid |
c | is the index of the row that |
c | stores the diagonal elements. |
c %-----------------------------------%
c
itop = kl + 1
imid = kl + ku + 1
ibot = 2*kl + ku + 1
c
if ( type .eq. 2 .or. type .eq. 5 ) then
c
c %-------------------------------%
c | Solving a standard eigenvalue |
c | problem in shift-invert mode. |
c | Factor (A-sigma*I). |
c %-------------------------------%
c
if (sigmai .eq. zero) then
c
c %-----------------------------------%
c | Construct (A-sigmar*I) and factor |
c | in real arithmetic. |
c %-----------------------------------%
c
call slacpy ('A', ibot, n, ab, lda, rfac, lda )
do 10 j = 1, n
rfac(imid,j) = ab(imid,j) - sigmar
10 continue
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr )
if (ierr .ne. 0) then
print*, ' '
print*, ' _NBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
else
c
c %-----------------------------------%
c | Construct (A-sigmar*I) and factor |
c | in COMPLEX arithmetic. |
c %-----------------------------------%
c
do 30 j = 1, n
do 20 i = itop, ibot
cfac(i,j) = cmplx(ab(i,j))
20 continue
30 continue
c
do 40 j = 1, n
cfac(imid,j) = cfac(imid,j)
$ - cmplx(sigmar, sigmai)
40 continue
c
call cgbtrf(n, n, kl, ku, cfac, lda, iwork, ierr )
if ( ierr .ne. 0) then
print*, ' '
print*, ' _NBAND: Error with _gbtrf. '
print*, ' '
go to 9000
end if
c
end if
else if ( type .eq. 3 ) then
c
c %-----------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | regular mode. Copy M to rfac, and call LAPACK |
c | routine sgbtrf to factor M. |
c %-----------------------------------------------%
c
call slacpy ('A', ibot, n, mb, lda, rfac, lda )
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if (ierr .ne. 0) then
print*, ' '
print*,'_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 .or. type .eq. 6 ) then
c
c %-------------------------------------------%
c | Solving generalized eigenvalue problem in |
c | shift-invert mode. |
c %-------------------------------------------%
c
if ( sigmai .eq. zero ) then
c
c %--------------------------------------------%
c | Construct (A - sigma*M) and factor in real |
c | arithmetic. |
c %--------------------------------------------%
c
do 60 j = 1,n
do 50 i = itop, ibot
rfac(i,j) = ab(i,j) - sigmar*mb(i,j)
50 continue
60 continue
c
call sgbtrf(n, n, kl, ku, rfac, lda, iwork, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
else
c
c %-----------------------------------------------%
c | Construct (A - sigma*M) and factor in complex |
c | arithmetic. |
c %-----------------------------------------------%
c
do 80 j = 1,n
do 70 i = itop, ibot
cfac(i,j) = cmplx( ab(i,j)-sigmar*mb(i,j),
& -sigmai*mb(i,j) )
70 continue
80 continue
c
call cgbtrf(n, n, kl, ku, cfac, lda, iwork, ierr)
if ( ierr .NE. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrf.'
print*, ' '
go to 9000
end if
c
end if
c
end if
c
c %--------------------------------------------%
c | M A I N L O O P (reverse communication) |
c %--------------------------------------------%
c
90 continue
c
call snaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2 ) then
c
if (sigmai .eq. zero) then
c
c %----------------------------------%
c | Shift is real. Perform |
c | y <--- OP*x = inv[A-sigmar*I]*x |
c | to force the starting vector |
c | into the range of OP. |
c %----------------------------------%
c
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _bgtrs. '
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------------------------%
c | Shift is COMPLEX. Perform |
c | y <--- OP*x = Real_Part{inv[A-sigma*I]*x} |
c | to force the starting vector into the |
c | range of OP. |
c %--------------------------------------------%
c
do 100 j = 1, n
workc(j) = cmplx(workd(ipntr(1)+j-1))
100 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 110 j = 1, n
workd(ipntr(2)+j-1) = real(workc(j))
110 continue
c
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | to force the starting vector into |
c | the range of OP. |
c %-----------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = Real_part{inv[A-SIGMA*M]*M}*x |
c | to force the starting vector into the |
c | range of OP. |
c %-----------------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
if ( sigmai .eq. zero ) then
c
c %---------------------%
c | Shift is real, stay |
c | in real arithmetic. |
c %---------------------%
c
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %--------------------------%
c | Goto complex arithmetic. |
c %--------------------------%
c
do 120 i = 1,n
workc(i) = cmplx(workd(ipntr(2)+i-1))
120 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 130 i = 1, n
workd(ipntr(2)+i-1) = real(workc(i))
130 continue
c
end if
c
else if ( type .eq. 5) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*I]}*x |
c | to force the starting vector into the |
c | range of OP. |
c %---------------------------------------%
c
do 140 j = 1, n
workc(j) = cmplx(workd(ipntr(1)+j-1))
140 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 150 j = 1, n
workd(ipntr(2)+j-1) = aimag(workc(j))
150 continue
c
else if ( type .eq. 6 ) then
c
c %----------------------------------------%
c | Perform y <-- OP*x |
c | Imaginary_part{inv[A-SIGMA*M]*M} |
c | to force the starting vector into the |
c | range of OP. |
c %----------------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
do 160 i = 1,n
workc(i) = cmplx(workd(ipntr(2)+i-1))
160 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 170 i = 1, n
workd(ipntr(2)+i-1) = aimag(workc(i))
170 continue
c
end if
c
else if (ido .eq. 1) then
c
if ( type .eq. 1) then
c
c %----------------------------%
c | Perform y <--- OP*x = A*x |
c %----------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else if ( type .eq. 2) then
c
if ( sigmai .eq. zero) then
c
c %----------------------------------%
c | Shift is real. Perform |
c | y <--- OP*x = inv[A-sigmar*I]*x. |
c %----------------------------------%
c
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
else
c
c %------------------------------------------%
c | Shift is COMPLEX. Perform |
c | y <-- OP*x = Real_Part{inv[A-sigma*I]*x} |
c | in COMPLEX arithmetic. |
c %------------------------------------------%
c
do 180 j = 1, n
workc(j) = cmplx(workd(ipntr(1)+j-1))
180 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 190 j = 1, n
workd(ipntr(2)+j-1) = real(workc(j))
190 continue
c
end if
c
else if ( type .eq. 3 ) then
c
c %-----------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c %-----------------------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, ab(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _bgtrs.'
print*, ' '
go to 9000
end if
c
else if ( type .eq. 4 ) then
c
c %--------------------------------------%
c | Perform y <-- inv(A-sigma*M)*(M*x). |
c | (M*x) has been computed and stored |
c | in workd(ipntr(3)). |
c %--------------------------------------%
c
if ( sigmai .eq. zero ) then
c
c %------------------------%
c | Shift is real, stay in |
c | real arithmetic. |
c %------------------------%
c
call scopy(n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgbtrs ('Notranspose', n, kl, ku, 1, rfac, lda,
& iwork, workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
else
c
c %---------------------------%
c | Go to COMPLEX arithmetic. |
c %---------------------------%
c
do 200 i = 1,n
workc(i) = cmplx(workd(ipntr(3)+i-1))
200 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error in _gbtrs.'
print*, ' '
go to 9000
end if
c
do 210 i = 1,n
workd(ipntr(2)+i-1) = real(workc(i))
210 continue
c
end if
c
else if ( type .eq. 5 ) then
c
c %---------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*I]*x} |
c %---------------------------------------%
c
do 220 j = 1, n
workc(j) = cmplx(workd(ipntr(1)+j-1))
220 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' _NBAND: Error with _gbtrs. '
print*, ' '
go to 9000
end if
c
do 230 j = 1, n
workd(ipntr(2)+j-1) = aimag(workc(j))
230 continue
c
else if ( type .eq. 6) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x |
c | = Imaginary_part{inv[A-SIGMA*M]*M}*x. |
c %-----------------------------------------%
c
do 240 i = 1,n
workc(i) = cmplx(workd(ipntr(3)+i-1))
240 continue
c
call cgbtrs ('Notranspose', n, kl, ku, 1, cfac, lda,
& iwork, workc, n, ierr)
if (ierr .ne. 0) then
print*, ' '
print*, '_NBAND: Error with _gbtrs.'
print*, ' '
go to 9000
end if
c
do 250 i = 1, n
workd(ipntr(2)+i-1) = aimag(workc(i))
250 continue
c
end if
c
else if (ido .eq. 2) then
c
c %--------------------%
c | Perform y <-- M*x |
c | Not used when |
c | type = 1,2. |
c %--------------------%
c
call sgbmv('Notranspose', n, n, kl, ku, one, mb(itop,1),
& lda, workd(ipntr(1)), 1, zero,
& workd(ipntr(2)), 1)
c
else
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | error. |
c %-----------------------------------------%
c
if ( info .lt. 0) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SNAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd info = ',info
print *, ' Check the documentation of _naupd '
print *, ' '
go to 9000
c
else
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
if (iparam(5) .gt. 0) then
c
call sneupd ( rvec, 'A', select, dr, di, z, ldz,
& sigmar, sigmai, workev, bmat, n, which,
& nev, tol, resid, ncv, v, ldv, iparam,
& ipntr, workd, workl, lworkl, info )
c
if ( info .ne. 0) then
c
c %------------------------------------%
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd = ', info
print *, ' Check the documentation of _neupd '
print *, ' '
go to 9000
c
else if ( sigmai .ne. zero ) then
c
if ( type .eq. 4 .or. type .eq. 6 ) then
c
first = .true.
do 270 j = 1, iparam(5)
c
c %----------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original |
c | generalized eigenvalue problem. |
c %----------------------------------%
c
if ( di(j) .eq. zero ) then
c
c %--------------------------------------%
c | Eigenvalue is real. Compute |
c | d = (x'*inv[A-sigma*M]*M*x) / (x'*x) |
c %--------------------------------------%
c
call sgbmv('Nontranspose', n, n, kl, ku, one,
$ mb(itop,1), lda, z(1,j), 1, zero,
$ workd, 1)
do i = 1, n
workc(i) = cmplx(workd(i))
end do
call cgbtrs ('Notranspose', n, kl, ku, 1,
$ cfac, lda, iwork, workc, n, info)
do i = 1, n
workd(i) = real(workc(i))
workd(i+n) = aimag(workc(i))
end do
denr = sdot(n, z(1,j), 1, workd, 1)
deni = sdot(n, z(1,j), 1, workd(n+1), 1)
numr = snrm2(n, z(1,j), 1)**2
dmdul = slapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar + numr*denr / dmdul
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
end if
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
c %-------------%
c | Compute M*x |
c %-------------%
c
call sgbmv('Nontranspose', n, n, kl, ku,
$ one, mb(itop,1), lda, z(1,j), 1, zero,
$ workd, 1)
call sgbmv('Nontranspose', n, n, kl, ku,
$ one, mb(itop,1), lda, z(1,j+1), 1,
$ zero, workd(n+1), 1)
do i = 1, n
workc(i) = cmplx(workd(i),workd(i+n))
end do
c
c %----------------------------%
c | Compute inv(A-sigma*M)*M*x |
c %----------------------------%
c
call cgbtrs('Notranspose',n,kl,ku,1,cfac,
$ lda, iwork, workc, n, info)
c
c %-------------------------------%
c | Compute x'*inv(A-sigma*M)*M*x |
c %-------------------------------%
c
do i = 1, n
workd(i) = real(workc(i))
workd(i+n) = aimag(workc(i))
end do
denr = sdot(n,z(1,j),1,workd,1)
denr = denr+sdot(n,z(1,j+1),1,workd(n+1),1)
deni = sdot(n,z(1,j),1,workd(n+1),1)
deni = deni - sdot(n,z(1,j+1),1,workd,1)
c
c %----------------%
c | Compute (x'*x) |
c %----------------%
c
numr = slapy2( snrm2(n, z(1,j), 1),
& snrm2(n, z(1, j+1), 1) )**2
c
c %----------------------------------------%
c | Compute (x'x) / (x'*inv(A-sigma*M)*Mx) |
c %----------------------------------------%
c
dmdul = slapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar+numr*denr / dmdul
di(j) = sigmai-numr*deni / dmdul
first = .false.
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
c
end if
c
else
c
c %---------------------------%
c | Get the second eigenvalue |
c | of the conjugate pair by |
c | taking the conjugate of |
c | previous one. |
c %---------------------------%
c
dr(j) = dr(j-1)
di(j) = -di(j-1)
first = .true.
c
end if
c
270 continue
c
else if ( type .eq. 2 .or. type .eq. 5) then
c
first = .true.
do 280 j = 1, iparam(5)
c
c %----------------------------------%
c | Use Rayleigh Quotient to recover |
c | eigenvalues of the original |
c | standard eigenvalue problem. |
c %----------------------------------%
c
if ( di(j) .eq. zero ) then
c
c %-------------------------------------%
c | Eigenvalue is real. Compute |
c | d = (x'*inv[A-sigma*I]*x) / (x'*x). |
c %-------------------------------------%
c
do i = 1, n
workc(i) = cmplx(z(i,j))
end do
call cgbtrs ('Notranspose', n, kl, ku, 1,
$ cfac, lda, iwork, workc, n, info)
do i = 1, n
workd(i) = real(workc(i))
workd(i+n) = aimag(workc(i))
end do
denr = sdot(n,z(1,j),1,workd,1)
deni = sdot(n,z(1,j),1,workd(n+1),1)
numr = snrm2(n, z(1,j), 1)**2
dmdul = slapy2(denr,deni)**2
if ( dmdul .ge. safmin ) then
dr(j) = sigmar + numr*denr / dmdul
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
c
end if
c
else if (first) then
c
c %------------------------%
c | Eigenvalue is complex. |
c | Compute the first one |
c | of the conjugate pair. |
c %------------------------%
c
do i = 1, n
workc(i) = cmplx( z(i,j), z(i,j+1) )
end do
c
c %---------------------------%
c | Compute inv[A-sigma*I]*x. |
c %---------------------------%
c
call cgbtrs('Notranspose',n,kl,ku,1,cfac,
$ lda, iwork, workc, n, info)
c
c %-----------------------------%
c | Compute x'*inv(A-sigma*I)*x |
c %-----------------------------%
c
do i = 1, n
workd(i) = real(workc(i))
workd(i+n) = aimag(workc(i))
end do
denr = sdot(n,z(1,j),1,workd,1)
denr = denr+sdot(n,z(1,j+1),1,workd(n+1),1)
deni = sdot(n,z(1,j),1,workd(n+1),1)
deni = deni - sdot(n,z(1,j+1),1,workd,1)
c
c %----------------%
c | Compute (x'*x) |
c %----------------%
c
numr = slapy2( snrm2(n, z(1,j), 1),
& snrm2(n, z(1,j+1), 1))**2
c
c %----------------------------------------%
c | Compute (x'x) / (x'*inv(A-sigma*I)*x). |
c %----------------------------------------%
c
dmdul = slapy2(denr,deni)**2
if (dmdul .ge. safmin) then
dr(j) = sigmar+numr*denr / dmdul
di(j) = sigmai-numr*deni / dmdul
first = .false.
else
c
c %---------------------%
c | dmdul is too small. |
c | Exit to avoid |
c | overflow. |
c %---------------------%
c
info = -15
go to 9000
end if
c
else
c
c %---------------------------%
c | Get the second eigenvalue |
c | of the conjugate pair by |
c | taking the conjugate of |
c | previous one. |
c %---------------------------%
c
dr(j) = dr(j-1)
di(j) = -di(j-1)
first = .true.
c
end if
c
280 continue
c
end if
c
end if
c
end if
c
end if
c
go to 9000
c
end if
c
c %----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %----------------------------------------%
c
go to 90
c
9000 continue
c
end
arpack-ng-3.1.5/EXAMPLES/Makefile 0000644 0001750 0001750 00000045733 12277671461 013213 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
subdir = EXAMPLES
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
SOURCES =
DIST_SOURCES =
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
distdir
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../
top_builddir = ..
top_srcdir = ..
SUBDIRS = BAND COMPLEX NONSYM SIMPLE SVD SYM
all: all-recursive
.SUFFIXES:
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile
installdirs: installdirs-recursive
installdirs-am:
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-generic distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am:
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am:
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am:
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \
check-am clean clean-generic clean-libtool cscopelist-am ctags \
ctags-am distclean distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
installdirs-am maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SYM/ 0000755 0001750 0001750 00000000000 12277671461 012267 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv4.f 0000644 0001750 0001750 00000041356 12277373057 013614 0000000 0000000 program ssdrv4
c
c Program to illustrate the idea of reverse communication
c in shift and invert mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c sgttrf.f and sgttrs to factor and solve a tridiagonal system of
c equations.
c
c We implement example four of ex-sym.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained from the finite element discretrization
c of the 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = (inv[A - sigma*M])*M and B = M.
c
c ... Use mode 3 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector by a scalar.
c snrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Real
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, two, four, six
parameter (zero = 0.0E+0, one = 1.0E+0,
& four = 4.0E+0, six = 6.0E+0,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external saxpy, scopy, sscal, snrm2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues (closest to |
c | the shift SIGMA) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMA to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %--------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 specified in the |
c | documentation of SSAUPD is used (IPARAM(7) = 3). |
c | All these options may be changed by the user. |
c | For details, see the documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------------------%
c | Call LAPACK routine to factor the tridiagonal matrix |
c | (A-SIGMA*M). The matrix A is the 1-d discrete |
c | Laplacian. The matrix M is the associated mass matrix |
c | arising from using piecewise linear finite elements |
c | on the interval [0, 1]. |
c %-------------------------------------------------------%
c
h = one / real(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two/h - sigma * r1
adl(j) = -one/h - sigma * r2
20 continue
call scopy (n, adl, 1, adu, 1)
call sgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' Error with _gttrf in _SDRV4.'
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1) then
c
c %--------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force the starting vector into the |
c | range of OP. The user should supply |
c | his/her own matrix vector multiplication |
c | routine and a linear system solver here. |
c | The matrix vector multiplication routine |
c | takes workd(ipntr(1)) as the input vector. |
c | The final result is returned to |
c | workd(ipntr(2)). |
c %--------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV4. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | the user only needs the linear system |
c | solver here that takes workd(ipntr(3) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call scopy ( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV4.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %-----------------------------------------%
c | Perform y <--- M*x |
c | Need the matrix vector multiplication |
c | routine here that takes workd(ipntr(1)) |
c | as the input and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), workd)
call mv(n, v(1,j), workd(n+1))
call saxpy (n, -d(j,1), workd(n+1), 1, workd, 1)
d(j,2) = snrm2(n, workd, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV4 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv4. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c matrix vector subroutine
c The matrix used is the 1 dimensional mass matrix
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / ( six*real(n+1))
call sscal(n, h, w, 1)
return
end
c------------------------------------------------------------------------
c matrix vector subroutine
c where the matrix is the finite element discretization of the
c 1 dimensional discrete Laplacian on [0,1] with zero Dirichlet
c boundary condition using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), two, one, h
parameter (one = 1.0E+0, two = 2.0E+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h)
c
h = one / real(n+1)
call sscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv4.f 0000644 0001750 0001750 00000041466 12277373057 013577 0000000 0000000 program dsdrv4
c
c Program to illustrate the idea of reverse communication
c in shift and invert mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c dgttrf.f and dgttrs to factor and solve a tridiagonal system of
c equations.
c
c We implement example four of ex-sym.doc in DOCUMENTS directory
c
c\Example-4
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained from the finite element discretrization
c of the 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = (inv[A - sigma*M])*M and B = M.
c
c ... Use mode 3 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 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 dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector by a scalar.
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv4.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, two, four, six
parameter (zero = 0.0D+0, one = 1.0D+0,
& four = 4.0D+0, six = 6.0D+0,
& two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external daxpy, dcopy, dscal, dnrm2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues (closest to |
c | the shift SIGMA) to be approximated. Since the |
c | shift-invert mode is used, WHICH is set to 'LM'. |
c | The user can modify NEV, NCV, SIGMA to solve |
c | problems of different sizes, and to get different |
c | parts of the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV4: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV4: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV4: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = zero
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 specified in the |
c | documentation of DSAUPD is used (IPARAM(7) = 3). |
c | All these options may be changed by the user. |
c | For details, see the documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------------------%
c | Call LAPACK routine to factor the tridiagonal matrix |
c | (A-SIGMA*M). The matrix A is the 1-d discrete |
c | Laplacian. The matrix M is the associated mass matrix |
c | arising from using piecewise linear finite elements |
c | on the interval [0, 1]. |
c %-------------------------------------------------------%
c
h = one / dble(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two/h - sigma * r1
adl(j) = -one/h - sigma * r2
20 continue
call dcopy (n, adl, 1, adu, 1)
call dgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' Error with _gttrf in _SDRV4.'
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1) then
c
c %--------------------------------------------%
c | Perform y <--- OP*x = inv[A-SIGMA*M]*M*x |
c | to force the starting vector into the |
c | range of OP. The user should supply |
c | his/her own matrix vector multiplication |
c | routine and a linear system solver here. |
c | The matrix vector multiplication routine |
c | takes workd(ipntr(1)) as the input vector. |
c | The final result is returned to |
c | workd(ipntr(2)). |
c %--------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV4. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %-----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*M]*M*x |
c | M*x has been saved in workd(ipntr(3)). |
c | the user only needs the linear system |
c | solver here that takes workd(ipntr(3) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call dcopy ( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV4.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %-----------------------------------------%
c | Perform y <--- M*x |
c | Need the matrix vector multiplication |
c | routine here that takes workd(ipntr(1)) |
c | as the input and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
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 %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), workd)
call mv(n, v(1,j), workd(n+1))
call daxpy (n, -d(j,1), workd(n+1), 1, workd, 1)
d(j,2) = dnrm2(n, workd, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV4 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv4. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c matrix vector subroutine
c The matrix used is the 1 dimensional mass matrix
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Double precision
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / ( six*dble(n+1))
call dscal(n, h, w, 1)
return
end
c------------------------------------------------------------------------
c matrix vector subroutine
c where the matrix is the finite element discretization of the
c 1 dimensional discrete Laplacian on [0,1] with zero Dirichlet
c boundary condition using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), two, one, h
parameter (one = 1.0D+0, two = 2.0D+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h)
c
h = one / dble(n+1)
call dscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv3.f 0000644 0001750 0001750 00000037527 12277373057 013601 0000000 0000000 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
c We implement example three of ex-sym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
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 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 av Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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),
& ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, four, six
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
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 | (IPARAM(7) = 2). All these options may be |
c | changed by the user. For details, see the |
c | documentation in DSAUPD . |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------%
c | Call LAPACK routine to factor the mass matrix. |
c | The mass matrix is the tridiagonal matrix |
c | arising from using piecewise linear finite |
c | elements on the interval [0, 1]. |
c %------------------------------------------------%
c
h = one / dble (n+1)
c
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = r1
adl(j) = r2
20 continue
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. '
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x. |
c | The user should supply his/her own |
c | matrix vector multiplication (A*x) |
c | routine and a linear system solver |
c | here. The matrix vector |
c | multiplication routine takes |
c | workd(ipntr(1)) as the input vector. |
c | The final result is returned to |
c | workd(ipntr(2)). The result of A*x |
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,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV3.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %-----------------------------------------%
c | Perform y <--- M*x. |
c | Need the matrix vector multiplication |
c | routine here that takes workd(ipntr(1)) |
c | as the input and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
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 %-----------------------------------------%
c
go to 10
c
end if
c
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD . |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if (ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD . |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd'
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout (6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV3 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv3 . |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1 dimensional mass matrix
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Double precision
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (dble (n+1)*six)
call dscal (n, h, w, 1)
return
end
c
c--------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the stiffness matrix obtained from the finite
c element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition using
c piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n),w(n), two, one, h
parameter ( one = 1.0D+0 , two = 2.0D+0 )
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1 / h).
c
h = one / dble (n+1)
call dscal (n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv6.f 0000644 0001750 0001750 00000043057 12277373057 013577 0000000 0000000 program dsdrv6
c
c Program to illustrate the idea of reverse communication
c in Cayley mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c dgttrf.f and dgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example six of ex-sym.doc in DOCUMENTS directory
c
c\Example-6
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = (inv[A-sigma*M])*(A+sigma*M) and B = M.
c
c ... Use mode 5 of DSAUPD.
c
c\BeginLib
c
c\References:
c 1. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c
c\Routines called:
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 dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector by a scalar.
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
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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),
& temp(maxn), ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, two, four, six
parameter (zero = 0.0D+0, one = 1.0D+0,
& four = 4.0D+0, six = 6.0D+0,
& two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external daxpy, dcopy, dscal, dnrm2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. Since the Cayley mode is used, |
c | WHICH is set to 'LM'. The user can modify NEV, |
c | NCV, SIGMA to solve problems of different sizes, |
c | and to get different parts of the spectrum. |
c | However, The following conditions must be |
c | satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 1.5D+2
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 5 specified in the |
c | documentation of DSAUPD is used (IPARAM(7) = 5). |
c | All these options may be changed by the user. For |
c | details, see the documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 5
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------------%
c | Call LAPACK routine to factor (A-sigma*M). The |
c | stiffness matrix A is the 1-d discrete Laplacian. |
c | The mass matrix M is the associated mass matrix |
c | arising from using piecewise linear finite elements |
c | on the interval [0, 1]. |
c %------------------------------------------------------%
c
h = one / dble(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two / h - sigma * r1
adl(j) = -one / h - sigma * r2
20 continue
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 _SDRV6.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------------------%
c | Perform y <--- OP*x = (inv[A-SIGMA*M])*(A+SIGMA*M)*x |
c | to force starting vector into the range of OP. The |
c | user should provide his/her matrix vector (A*x, M*x) |
c | multiplication routines and a linear system solver |
c | here. The matrix vector multiplication routine takes |
c | workd(ipntr(1)) as the input vector. The final |
c | result is returned to workd(ipntr(2)). |
c %-------------------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call mv (n, workd(ipntr(1)), temp)
call daxpy(n, sigma, temp, 1, workd(ipntr(2)), 1)
c
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV6.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %----------------------------------------------------%
c | Perform y <-- OP*x = inv[A-SIGMA*M]*(A+SIGMA*M)*x. |
c | M*x has been saved in workd(ipntr(3)). The user |
c | need the matrix vector multiplication (A*x) |
c | routine and a linear system solver here. The |
c | matrix vector multiplication routine takes |
c | workd(ipntr(1)) as the input, and the result is |
c | combined with workd(ipntr(3)) to form the input |
c | for the linear system solver. The final result is |
c | returned to workd(ipntr(2)). |
c %----------------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call daxpy(n, sigma, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV6. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %--------------------------------------------%
c | Perform y <--- M*x. |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %--------------------------------------------%
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 %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd. '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
nconv = iparam(5)
do 30 j=1, nconv
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)
d(j,2) = d(j,2) / abs(d(j,1))
30 continue
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV6 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is', n
print *, ' The number of Ritz values requested is', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv6. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix used is the 1 dimensional mass matrix
c arising from using the piecewise linear finite element
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (six*dble(n+1))
call dscal(n, h, w, 1)
return
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the stiffness matrix obtained from the
c finite element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, h
parameter (one = 1.0D+0, two = 2.0D+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h).
c
h = one / dble(n+1)
call dscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv1.f 0000644 0001750 0001750 00000034063 12277373057 013606 0000000 0000000 program ssdrv1
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square [0,1]x[0,1]
c with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c
c ... Assume "call av (n,x,y)" computes y = A*x.
c
c ... Use mode 1 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c saxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
$ ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Real
& tol, sigma
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external snrm2, saxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of SSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in SSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV1 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv1. |
c %---------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c
subroutine av (nx, v, w)
integer nx, j, lo, n2
Real
& v(nx*nx), w(nx*nx), one, h2
parameter ( one = 1.0E+0 )
c
call tv(nx,v(1),w(1))
call saxpy(nx, -one, 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 saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, 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 saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
c Scale the vector w by (1/h^2), where h is the mesh size
c
n2 = nx*nx
h2 = one / real((nx+1)*(nx+1))
call sscal(n2, one/h2, w, 1)
return
end
c
c-------------------------------------------------------------------
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), dd, dl, du
c
Real
& one
parameter (one = 1.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
c diagonal, DL on the subdiagonal, and DU on the superdiagonal.
c
c
dd = 4.0E+0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv6.f 0000644 0001750 0001750 00000042747 12277373057 013623 0000000 0000000 program ssdrv6
c
c Program to illustrate the idea of reverse communication
c in Cayley mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c sgttrf.f and sgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example six of ex-sym.doc in DOCUMENTS directory
c
c\Example-6
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = (inv[A-sigma*M])*(A+sigma*M) and B = M.
c
c ... Use mode 5 of SSAUPD.
c
c\BeginLib
c
c\References:
c 1. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector by a scalar.
c snrm2 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
c\Author
c Danny Sorensen
c Richard Lehoucq
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv6.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
& temp(maxn), ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Real
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, two, four, six
parameter (zero = 0.0E+0, one = 1.0E+0,
& four = 4.0E+0, six = 6.0E+0,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external saxpy, scopy, sscal, snrm2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. Since the Cayley mode is used, |
c | WHICH is set to 'LM'. The user can modify NEV, |
c | NCV, SIGMA to solve problems of different sizes, |
c | and to get different parts of the spectrum. |
c | However, The following conditions must be |
c | satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV6: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV6: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV6: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = 1.5E+2
c
c %--------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 5 specified in the |
c | documentation of SSAUPD is used (IPARAM(7) = 5). |
c | All these options may be changed by the user. For |
c | details, see the documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 5
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------------%
c | Call LAPACK routine to factor (A-sigma*M). The |
c | stiffness matrix A is the 1-d discrete Laplacian. |
c | The mass matrix M is the associated mass matrix |
c | arising from using piecewise linear finite elements |
c | on the interval [0, 1]. |
c %------------------------------------------------------%
c
h = one / real(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two / h - sigma * r1
adl(j) = -one / h - sigma * r2
20 continue
call scopy (n, adl, 1, adu, 1)
call sgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrf in _SDRV6.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------------------%
c | Perform y <--- OP*x = (inv[A-SIGMA*M])*(A+SIGMA*M)*x |
c | to force starting vector into the range of OP. The |
c | user should provide his/her matrix vector (A*x, M*x) |
c | multiplication routines and a linear system solver |
c | here. The matrix vector multiplication routine takes |
c | workd(ipntr(1)) as the input vector. The final |
c | result is returned to workd(ipntr(2)). |
c %-------------------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call mv (n, workd(ipntr(1)), temp)
call saxpy(n, sigma, temp, 1, workd(ipntr(2)), 1)
c
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV6.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %----------------------------------------------------%
c | Perform y <-- OP*x = inv[A-SIGMA*M]*(A+SIGMA*M)*x. |
c | M*x has been saved in workd(ipntr(3)). The user |
c | need the matrix vector multiplication (A*x) |
c | routine and a linear system solver here. The |
c | matrix vector multiplication routine takes |
c | workd(ipntr(1)) as the input, and the result is |
c | combined with workd(ipntr(3)) to form the input |
c | for the linear system solver. The final result is |
c | returned to workd(ipntr(2)). |
c %----------------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call saxpy(n, sigma, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV6. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %--------------------------------------------%
c | Perform y <--- M*x. |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %--------------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd. '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
nconv = iparam(5)
do 30 j=1, nconv
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy (n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
30 continue
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV6 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is', n
print *, ' The number of Ritz values requested is', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv6. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix used is the 1 dimensional mass matrix
c arising from using the piecewise linear finite element
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n), w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (six*real(n+1))
call sscal(n, h, w, 1)
return
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the stiffness matrix obtained from the
c finite element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), one, two, h
parameter (one = 1.0E+0, two = 2.0E+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h).
c
h = one / real(n+1)
call sscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv3.f 0000644 0001750 0001750 00000037346 12277373057 013617 0000000 0000000 program ssdrv3
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 sgttrf.f
c and sgttrs.f to factor and solve a tridiagonal system of equations.
c
c We implement example three of ex-sym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*M*x in inverse mode,
c where A and M are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
c ... OP = inv[M]*A and B = M.
c
c ... Use mode 2 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c sscal Level 1 BLAS that scales a vector by a scalar.
c scopy Level 1 BLAS that copies one vector to another.
c snrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv3.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
& ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Real
& sigma, r1, r2, tol, h
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, four, six
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
& snrm2
external saxpy, scopy, sscal, snrm2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV3: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 SSAUPD is used |
c | (IPARAM(7) = 2). All these options may be |
c | changed by the user. For details, see the |
c | documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------%
c | Call LAPACK routine to factor the mass matrix. |
c | The mass matrix is the tridiagonal matrix |
c | arising from using piecewise linear finite |
c | elements on the interval [0, 1]. |
c %------------------------------------------------%
c
h = one / real (n+1)
c
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = r1
adl(j) = r2
20 continue
call scopy (n, adl, 1, adu, 1)
call sgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrf in _SDRV3. '
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x. |
c | The user should supply his/her own |
c | matrix vector multiplication (A*x) |
c | routine and a linear system solver |
c | here. The matrix vector |
c | multiplication routine takes |
c | workd(ipntr(1)) as the input vector. |
c | The final result is returned to |
c | workd(ipntr(2)). The result of A*x |
c | overwrites workd(ipntr(1)). |
c %--------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
call scopy(n, workd(ipntr(2)), 1, workd(ipntr(1)), 1)
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV3.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %-----------------------------------------%
c | Perform y <--- M*x. |
c | Need the matrix vector multiplication |
c | routine here that takes workd(ipntr(1)) |
c | as the input and returns the result to |
c | workd(ipntr(2)). |
c %-----------------------------------------%
c
call mv (n, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SSAUPD |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if (ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd'
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy(n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV3 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv3. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1 dimensional mass matrix
c on the interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (real (n+1)*six)
call sscal(n, h, w, 1)
return
end
c
c--------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the stiffness matrix obtained from the finite
c element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition using
c piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Real
& v(n),w(n), two, one, h
parameter ( one = 1.0E+0 , two = 2.0E+0 )
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1 / h).
c
h = one / real (n+1)
call sscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/README 0000644 0001750 0001750 00000004135 12277373057 013072 0000000 0000000 1. Purpose
-------
This directory contains example drivers that call ARPACK subroutines
[s,d]saupd.f and [s,d]seupd.f to solve SYMMETRIC eigenvalue problems
using regular, inverse, shift-invert or other special modes (such as
Cayley, Bucking etc.)
These drivers illustrate how to set various ARPACK parameters to solve
different problems in different modes. They provide a guideline on how
to use ARPACK's reverse communication interface. The user may modify
any one of these drivers, and provide his/her own matrix vector
multiplication routine to solve the problem of his/her own interest.
2. Naming convention
-----------------
The name for each driver has the form 'XsdrvN.f', where
X - is 's' (single precision)
or 'd' (double precision)
N - is a number between 1 and 6. If
N = 1, the driver solves a STANDARD eigenvalue problem in
REGULAR mode
N = 2, the driver solves a STANDARD eigenvalue problem in
SHIFT-INVERT mode.
N = 3, the driver solves a GENERALIZED eigenvalue problem in
INVERSE mode
N = 4, the driver solves a GENERALIZED eigenvalue problem in
SHIFT-INVERT mode.
These are 4 commonly used drivers. For shift-invert (N=2,4) mode
the user needs to supply a linear system solver to perform
y=inv[A-sigma*B]*x.
When N > 4, a special mode is used. If
N = 5, the driver solves a GENERALIZED eigenvalue problem in
BUCKLING mode.
N = 6, the driver solves a GENERALIZED eigenvalue problem in
CAYLEY mode.
These two drivers require the user to provide linear system
solvers also. For more information on Cayley and Buckling mode,
see the following reference:
R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
SIAM J. Matr. Anal. Apps., January (1993).
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make ssdrv1". Then
execute using "ssdrv1".
arpack-ng-3.1.5/EXAMPLES/SYM/Makefile.am 0000644 0001750 0001750 00000002355 12277670164 014247 0000000 0000000 check_PROGRAMS = dsdrv1 dsdrv2 dsdrv3 dsdrv4 dsdrv5 dsdrv6 ssdrv1 ssdrv2 ssdrv3 ssdrv4 ssdrv5 ssdrv6
dsdrv1_SOURCES = dsdrv1.f
dsdrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv2_SOURCES = dsdrv2.f
dsdrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv3_SOURCES = dsdrv3.f
dsdrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv4_SOURCES = dsdrv4.f
dsdrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv5_SOURCES = dsdrv5.f
dsdrv5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv6_SOURCES = dsdrv6.f
dsdrv6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv1_SOURCES = ssdrv1.f
ssdrv1_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv2_SOURCES = ssdrv2.f
ssdrv2_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv3_SOURCES = ssdrv3.f
ssdrv3_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv4_SOURCES = ssdrv4.f
ssdrv4_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv5_SOURCES = ssdrv5.f
ssdrv5_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv6_SOURCES = ssdrv6.f
ssdrv6_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = dsdrv1 dsdrv2 dsdrv3 dsdrv4 dsdrv5 dsdrv6 ssdrv1 ssdrv2 ssdrv3 ssdrv4 ssdrv5 ssdrv6
arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv2.f 0000644 0001750 0001750 00000033204 12277373057 013603 0000000 0000000 program ssdrv2
c
c Program to illustrate the idea of reverse communication
c in shift and invert mode for a standard symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c sgttrf.f and sgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example two of ex-sym.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the central difference discretization
c of the 1-dimensional Laplacian on [0,1] with zero Dirichlet
c boundary condition.
c ... OP = (inv[A - sigma*I]) and B = I.
c ... Use mode 3 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c saxpy saxpy Level 1 BLAS that computes y <- alpha*x+y.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Real
& sigma, tol, h2
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, two
parameter (zero = 0.0E+0, one = 1.0E+0,
& two = 2.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external saxpy, snrm2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = 'I'. |
c | NEV is the number of eigenvalues (closest to |
c | SIGMA) to be approximated. Since the shift-invert |
c | mode is used, WHICH is set to 'LM'. The user can |
c | modify NEV, NCV, SIGMA to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV2: NCV is greater than MAXNCV '
go to 9000
end if
c
bmat = 'I'
which = 'LM'
sigma = zero
c
c %--------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 SSAUPD is used |
c | (IPARAM(7) = 3). All these options may be |
c | changed by the user. For details, see the |
c | documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-----------------------------------------------------%
c | Call LAPACK routine to factor (A-SIGMA*I), where A |
c | is the 1-d Laplacian. |
c %-----------------------------------------------------%
c
h2 = one / real((n+1)*(n+1))
do 20 j=1,n
ad(j) = two / h2 - sigma
adl(j) = -one / h2
20 continue
call scopy (n, adl, 1, adu, 1)
call sgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrf in SDRV2.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*I]*x. |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(1)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %----------------------------------------%
c
call scopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
c
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV2. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %----------------------------%
c | Error message. Check the |
c | documentation in SSAUPD |
c %----------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), ax)
call saxpy(n, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV2 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1 dimensional discrete Laplacian on
c the interval [0,1] with zero Dirichlet boundary condition.
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), one, two, h2
parameter (one = 1.0E+0, two = 2.0E+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1 / h^2).
c
h2 = one / real((n+1)*(n+1))
call sscal(n, one/h2, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/Makefile 0000644 0001750 0001750 00000114700 12277671461 013652 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/SYM/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = dsdrv1$(EXEEXT) dsdrv2$(EXEEXT) dsdrv3$(EXEEXT) \
dsdrv4$(EXEEXT) dsdrv5$(EXEEXT) dsdrv6$(EXEEXT) \
ssdrv1$(EXEEXT) ssdrv2$(EXEEXT) ssdrv3$(EXEEXT) \
ssdrv4$(EXEEXT) ssdrv5$(EXEEXT) ssdrv6$(EXEEXT)
TESTS = dsdrv1$(EXEEXT) dsdrv2$(EXEEXT) dsdrv3$(EXEEXT) \
dsdrv4$(EXEEXT) dsdrv5$(EXEEXT) dsdrv6$(EXEEXT) \
ssdrv1$(EXEEXT) ssdrv2$(EXEEXT) ssdrv3$(EXEEXT) \
ssdrv4$(EXEEXT) ssdrv5$(EXEEXT) ssdrv6$(EXEEXT)
subdir = EXAMPLES/SYM
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dsdrv1_OBJECTS = dsdrv1.$(OBJEXT)
dsdrv1_OBJECTS = $(am_dsdrv1_OBJECTS)
am__DEPENDENCIES_1 =
dsdrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_dsdrv2_OBJECTS = dsdrv2.$(OBJEXT)
dsdrv2_OBJECTS = $(am_dsdrv2_OBJECTS)
dsdrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv3_OBJECTS = dsdrv3.$(OBJEXT)
dsdrv3_OBJECTS = $(am_dsdrv3_OBJECTS)
dsdrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv4_OBJECTS = dsdrv4.$(OBJEXT)
dsdrv4_OBJECTS = $(am_dsdrv4_OBJECTS)
dsdrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv5_OBJECTS = dsdrv5.$(OBJEXT)
dsdrv5_OBJECTS = $(am_dsdrv5_OBJECTS)
dsdrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv6_OBJECTS = dsdrv6.$(OBJEXT)
dsdrv6_OBJECTS = $(am_dsdrv6_OBJECTS)
dsdrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv1_OBJECTS = ssdrv1.$(OBJEXT)
ssdrv1_OBJECTS = $(am_ssdrv1_OBJECTS)
ssdrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv2_OBJECTS = ssdrv2.$(OBJEXT)
ssdrv2_OBJECTS = $(am_ssdrv2_OBJECTS)
ssdrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv3_OBJECTS = ssdrv3.$(OBJEXT)
ssdrv3_OBJECTS = $(am_ssdrv3_OBJECTS)
ssdrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv4_OBJECTS = ssdrv4.$(OBJEXT)
ssdrv4_OBJECTS = $(am_ssdrv4_OBJECTS)
ssdrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv5_OBJECTS = ssdrv5.$(OBJEXT)
ssdrv5_OBJECTS = $(am_ssdrv5_OBJECTS)
ssdrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv6_OBJECTS = ssdrv6.$(OBJEXT)
ssdrv6_OBJECTS = $(am_ssdrv6_OBJECTS)
ssdrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dsdrv1_SOURCES) $(dsdrv2_SOURCES) $(dsdrv3_SOURCES) \
$(dsdrv4_SOURCES) $(dsdrv5_SOURCES) $(dsdrv6_SOURCES) \
$(ssdrv1_SOURCES) $(ssdrv2_SOURCES) $(ssdrv3_SOURCES) \
$(ssdrv4_SOURCES) $(ssdrv5_SOURCES) $(ssdrv6_SOURCES)
DIST_SOURCES = $(dsdrv1_SOURCES) $(dsdrv2_SOURCES) $(dsdrv3_SOURCES) \
$(dsdrv4_SOURCES) $(dsdrv5_SOURCES) $(dsdrv6_SOURCES) \
$(ssdrv1_SOURCES) $(ssdrv2_SOURCES) $(ssdrv3_SOURCES) \
$(ssdrv4_SOURCES) $(ssdrv5_SOURCES) $(ssdrv6_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SYM
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SYM
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
dsdrv1_SOURCES = dsdrv1.f
dsdrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv2_SOURCES = dsdrv2.f
dsdrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv3_SOURCES = dsdrv3.f
dsdrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv4_SOURCES = dsdrv4.f
dsdrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv5_SOURCES = dsdrv5.f
dsdrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv6_SOURCES = dsdrv6.f
dsdrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv1_SOURCES = ssdrv1.f
ssdrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv2_SOURCES = ssdrv2.f
ssdrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv3_SOURCES = ssdrv3.f
ssdrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv4_SOURCES = ssdrv4.f
ssdrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv5_SOURCES = ssdrv5.f
ssdrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv6_SOURCES = ssdrv6.f
ssdrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SYM/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SYM/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dsdrv1$(EXEEXT): $(dsdrv1_OBJECTS) $(dsdrv1_DEPENDENCIES) $(EXTRA_dsdrv1_DEPENDENCIES)
@rm -f dsdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv1_OBJECTS) $(dsdrv1_LDADD) $(LIBS)
dsdrv2$(EXEEXT): $(dsdrv2_OBJECTS) $(dsdrv2_DEPENDENCIES) $(EXTRA_dsdrv2_DEPENDENCIES)
@rm -f dsdrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv2_OBJECTS) $(dsdrv2_LDADD) $(LIBS)
dsdrv3$(EXEEXT): $(dsdrv3_OBJECTS) $(dsdrv3_DEPENDENCIES) $(EXTRA_dsdrv3_DEPENDENCIES)
@rm -f dsdrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv3_OBJECTS) $(dsdrv3_LDADD) $(LIBS)
dsdrv4$(EXEEXT): $(dsdrv4_OBJECTS) $(dsdrv4_DEPENDENCIES) $(EXTRA_dsdrv4_DEPENDENCIES)
@rm -f dsdrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv4_OBJECTS) $(dsdrv4_LDADD) $(LIBS)
dsdrv5$(EXEEXT): $(dsdrv5_OBJECTS) $(dsdrv5_DEPENDENCIES) $(EXTRA_dsdrv5_DEPENDENCIES)
@rm -f dsdrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv5_OBJECTS) $(dsdrv5_LDADD) $(LIBS)
dsdrv6$(EXEEXT): $(dsdrv6_OBJECTS) $(dsdrv6_DEPENDENCIES) $(EXTRA_dsdrv6_DEPENDENCIES)
@rm -f dsdrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv6_OBJECTS) $(dsdrv6_LDADD) $(LIBS)
ssdrv1$(EXEEXT): $(ssdrv1_OBJECTS) $(ssdrv1_DEPENDENCIES) $(EXTRA_ssdrv1_DEPENDENCIES)
@rm -f ssdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv1_OBJECTS) $(ssdrv1_LDADD) $(LIBS)
ssdrv2$(EXEEXT): $(ssdrv2_OBJECTS) $(ssdrv2_DEPENDENCIES) $(EXTRA_ssdrv2_DEPENDENCIES)
@rm -f ssdrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv2_OBJECTS) $(ssdrv2_LDADD) $(LIBS)
ssdrv3$(EXEEXT): $(ssdrv3_OBJECTS) $(ssdrv3_DEPENDENCIES) $(EXTRA_ssdrv3_DEPENDENCIES)
@rm -f ssdrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv3_OBJECTS) $(ssdrv3_LDADD) $(LIBS)
ssdrv4$(EXEEXT): $(ssdrv4_OBJECTS) $(ssdrv4_DEPENDENCIES) $(EXTRA_ssdrv4_DEPENDENCIES)
@rm -f ssdrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv4_OBJECTS) $(ssdrv4_LDADD) $(LIBS)
ssdrv5$(EXEEXT): $(ssdrv5_OBJECTS) $(ssdrv5_DEPENDENCIES) $(EXTRA_ssdrv5_DEPENDENCIES)
@rm -f ssdrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv5_OBJECTS) $(ssdrv5_LDADD) $(LIBS)
ssdrv6$(EXEEXT): $(ssdrv6_OBJECTS) $(ssdrv6_DEPENDENCIES) $(EXTRA_ssdrv6_DEPENDENCIES)
@rm -f ssdrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv6_OBJECTS) $(ssdrv6_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dsdrv1.log: dsdrv1$(EXEEXT)
@p='dsdrv1$(EXEEXT)'; \
b='dsdrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv2.log: dsdrv2$(EXEEXT)
@p='dsdrv2$(EXEEXT)'; \
b='dsdrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv3.log: dsdrv3$(EXEEXT)
@p='dsdrv3$(EXEEXT)'; \
b='dsdrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv4.log: dsdrv4$(EXEEXT)
@p='dsdrv4$(EXEEXT)'; \
b='dsdrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv5.log: dsdrv5$(EXEEXT)
@p='dsdrv5$(EXEEXT)'; \
b='dsdrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv6.log: dsdrv6$(EXEEXT)
@p='dsdrv6$(EXEEXT)'; \
b='dsdrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv1.log: ssdrv1$(EXEEXT)
@p='ssdrv1$(EXEEXT)'; \
b='ssdrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv2.log: ssdrv2$(EXEEXT)
@p='ssdrv2$(EXEEXT)'; \
b='ssdrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv3.log: ssdrv3$(EXEEXT)
@p='ssdrv3$(EXEEXT)'; \
b='ssdrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv4.log: ssdrv4$(EXEEXT)
@p='ssdrv4$(EXEEXT)'; \
b='ssdrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv5.log: ssdrv5$(EXEEXT)
@p='ssdrv5$(EXEEXT)'; \
b='ssdrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv6.log: ssdrv6$(EXEEXT)
@p='ssdrv6$(EXEEXT)'; \
b='ssdrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv1.f 0000644 0001750 0001750 00000034207 12277373057 013567 0000000 0000000 program dsdrv1
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square [0,1]x[0,1]
c with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c
c ... Assume "call av (n,x,y)" computes y = A*x.
c
c ... Use mode 1 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 Ritz vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c daxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv1.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
$ ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Double precision
& tol, sigma
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external dnrm2, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV1: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of DSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av (nx, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in DSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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 %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(nx, v(1,j), ax)
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
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV1 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv1. |
c %---------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c
subroutine av (nx, v, w)
integer nx, j, lo, n2
Double precision
& v(nx*nx), w(nx*nx), one, h2
parameter ( one = 1.0D+0 )
c
call tv(nx,v(1),w(1))
call daxpy(nx, -one, 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 daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, 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 daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
c Scale the vector w by (1/h^2), where h is the mesh size
c
n2 = nx*nx
h2 = one / dble((nx+1)*(nx+1))
call dscal(n2, one/h2, w, 1)
return
end
c
c-------------------------------------------------------------------
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), dd, dl, du
c
Double precision
& one
parameter (one = 1.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
c
dd = 4.0D+0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/ssdrv5.f 0000644 0001750 0001750 00000041140 12277373057 013604 0000000 0000000 program ssdrv5
c
c Program to illustrate the idea of reverse communication
c in Buckling mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c sgttrf.f and sgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example five of ex-sym.doc in DOCUMENTS directory
c
c\Example-5
c ... Suppose we want to solve K*x = lambda*KG*x in Buckling mode
c where K and KG are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c ... OP = (inv[K - sigma*KG])*K and B = K.
c ... Use mode 4 of SSAUPD.
c
c\BeginLib
c
c\References:
c 1. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c sgttrf LAPACK tridiagonal factorization routine.
c sgttrs LAPACK tridiagonal solve routine.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector by a scalar.
c snrm2 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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxn), d(maxncv,2), resid(maxn),
& ad(maxn), adl(maxn), adu(maxn), adu2(maxn),
& ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Real
& h, sigma, r1, r2, tol
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one, two, four, six
parameter (zero = 0.0E+0, one = 1.0E+0,
& four = 4.0E+0, six = 6.0E+0,
& two = 2.0E+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external saxpy, scopy, sscal, snrm2, sgttrf, sgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. Since the buckling mode is used, |
c | WHICH is set to 'LM'. The user can modify NEV, |
c | NCV, SIGMA to solve problems of different sizes, |
c | and to get different parts of the spectrum. |
c | However, The following conditions must be |
c | satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c | |
c | The shift SIGMA cannot be zero!!! |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = one
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SSAUPD 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 SSAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 4 specified in the |
c | documentation of SSAUPD is used (IPARAM(7) = 4). |
c | All these options may be changed by the user. For |
c | details, see the documentation in SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 4
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------------%
c | Call LAPACK routine to factor the tridiagonal matrix |
c | (K-SIGMA*KG). The matrix A is the 1-d discrete |
c | Laplacian on the interval [0,1] with zero Dirichlet |
c | boundary condition. The matrix M is the associated |
c | mass matrix arising from using piecewise linear |
c | finite elements on the interval [0, 1]. |
c %------------------------------------------------------%
c
h = one / real(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two / h - sigma * r1
adl(j) = -one / h- sigma * r2
20 continue
call scopy (n, adl, 1, adu, 1)
call sgttrf (n, adl, ad, adu, adu2, ipiv, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrf in _SDRV5.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[K-SIGMA*KG]*K*x |
c | to force starting vector into the range |
c | of OP. The user should provide his/her |
c | matrix vector multiplication routine and |
c | a linear system solver here. The matrix |
c | vector multiplication routine (K*x) takes |
c | workd(ipntr(1)) as the input vector. The |
c | final result is returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
c
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in SDRV5.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %------------------------------------------%
c | Perform y <-- OP*x=inv(K-sigma*KG)*K*x. |
c | K*x has been saved in workd(ipntr(3)). |
c | The user only needs the linear system |
c | solver here that takes workd(ipntr(3)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %------------------------------------------%
c
call scopy ( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call sgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV5.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- K*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
c
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in SSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, d, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
if (ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ',ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), ax)
call mv(n, v(1,j), mx)
call saxpy (n, -d(j,1), mx, 1, ax, 1)
d(j,2) = snrm2(n, ax, 1)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
call smout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV5 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is', n
print *, ' The number of Ritz values requested is', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program ssdrv5. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1-dimensional mass matrix
c arising from using piecewise linear finite elements on the
c interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Real
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (six*real(n+1))
call sscal(n, h, w, 1)
return
end
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the stiffness matrix obtained from the
c finite element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Real
& v(n), w(n), one, two, h
parameter (one = 1.0E+0, two = 2.0E+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h)
c
h = one / (n+1)
call sscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/Makefile.in 0000644 0001750 0001750 00000113041 12277670175 014255 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = dsdrv1$(EXEEXT) dsdrv2$(EXEEXT) dsdrv3$(EXEEXT) \
dsdrv4$(EXEEXT) dsdrv5$(EXEEXT) dsdrv6$(EXEEXT) \
ssdrv1$(EXEEXT) ssdrv2$(EXEEXT) ssdrv3$(EXEEXT) \
ssdrv4$(EXEEXT) ssdrv5$(EXEEXT) ssdrv6$(EXEEXT)
TESTS = dsdrv1$(EXEEXT) dsdrv2$(EXEEXT) dsdrv3$(EXEEXT) \
dsdrv4$(EXEEXT) dsdrv5$(EXEEXT) dsdrv6$(EXEEXT) \
ssdrv1$(EXEEXT) ssdrv2$(EXEEXT) ssdrv3$(EXEEXT) \
ssdrv4$(EXEEXT) ssdrv5$(EXEEXT) ssdrv6$(EXEEXT)
subdir = EXAMPLES/SYM
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dsdrv1_OBJECTS = dsdrv1.$(OBJEXT)
dsdrv1_OBJECTS = $(am_dsdrv1_OBJECTS)
am__DEPENDENCIES_1 =
dsdrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_dsdrv2_OBJECTS = dsdrv2.$(OBJEXT)
dsdrv2_OBJECTS = $(am_dsdrv2_OBJECTS)
dsdrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv3_OBJECTS = dsdrv3.$(OBJEXT)
dsdrv3_OBJECTS = $(am_dsdrv3_OBJECTS)
dsdrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv4_OBJECTS = dsdrv4.$(OBJEXT)
dsdrv4_OBJECTS = $(am_dsdrv4_OBJECTS)
dsdrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv5_OBJECTS = dsdrv5.$(OBJEXT)
dsdrv5_OBJECTS = $(am_dsdrv5_OBJECTS)
dsdrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_dsdrv6_OBJECTS = dsdrv6.$(OBJEXT)
dsdrv6_OBJECTS = $(am_dsdrv6_OBJECTS)
dsdrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv1_OBJECTS = ssdrv1.$(OBJEXT)
ssdrv1_OBJECTS = $(am_ssdrv1_OBJECTS)
ssdrv1_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv2_OBJECTS = ssdrv2.$(OBJEXT)
ssdrv2_OBJECTS = $(am_ssdrv2_OBJECTS)
ssdrv2_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv3_OBJECTS = ssdrv3.$(OBJEXT)
ssdrv3_OBJECTS = $(am_ssdrv3_OBJECTS)
ssdrv3_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv4_OBJECTS = ssdrv4.$(OBJEXT)
ssdrv4_OBJECTS = $(am_ssdrv4_OBJECTS)
ssdrv4_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv5_OBJECTS = ssdrv5.$(OBJEXT)
ssdrv5_OBJECTS = $(am_ssdrv5_OBJECTS)
ssdrv5_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_ssdrv6_OBJECTS = ssdrv6.$(OBJEXT)
ssdrv6_OBJECTS = $(am_ssdrv6_OBJECTS)
ssdrv6_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dsdrv1_SOURCES) $(dsdrv2_SOURCES) $(dsdrv3_SOURCES) \
$(dsdrv4_SOURCES) $(dsdrv5_SOURCES) $(dsdrv6_SOURCES) \
$(ssdrv1_SOURCES) $(ssdrv2_SOURCES) $(ssdrv3_SOURCES) \
$(ssdrv4_SOURCES) $(ssdrv5_SOURCES) $(ssdrv6_SOURCES)
DIST_SOURCES = $(dsdrv1_SOURCES) $(dsdrv2_SOURCES) $(dsdrv3_SOURCES) \
$(dsdrv4_SOURCES) $(dsdrv5_SOURCES) $(dsdrv6_SOURCES) \
$(ssdrv1_SOURCES) $(ssdrv2_SOURCES) $(ssdrv3_SOURCES) \
$(ssdrv4_SOURCES) $(ssdrv5_SOURCES) $(ssdrv6_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
dsdrv1_SOURCES = dsdrv1.f
dsdrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv2_SOURCES = dsdrv2.f
dsdrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv3_SOURCES = dsdrv3.f
dsdrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv4_SOURCES = dsdrv4.f
dsdrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv5_SOURCES = dsdrv5.f
dsdrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
dsdrv6_SOURCES = dsdrv6.f
dsdrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv1_SOURCES = ssdrv1.f
ssdrv1_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv2_SOURCES = ssdrv2.f
ssdrv2_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv3_SOURCES = ssdrv3.f
ssdrv3_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv4_SOURCES = ssdrv4.f
ssdrv4_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv5_SOURCES = ssdrv5.f
ssdrv5_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssdrv6_SOURCES = ssdrv6.f
ssdrv6_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SYM/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SYM/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dsdrv1$(EXEEXT): $(dsdrv1_OBJECTS) $(dsdrv1_DEPENDENCIES) $(EXTRA_dsdrv1_DEPENDENCIES)
@rm -f dsdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv1_OBJECTS) $(dsdrv1_LDADD) $(LIBS)
dsdrv2$(EXEEXT): $(dsdrv2_OBJECTS) $(dsdrv2_DEPENDENCIES) $(EXTRA_dsdrv2_DEPENDENCIES)
@rm -f dsdrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv2_OBJECTS) $(dsdrv2_LDADD) $(LIBS)
dsdrv3$(EXEEXT): $(dsdrv3_OBJECTS) $(dsdrv3_DEPENDENCIES) $(EXTRA_dsdrv3_DEPENDENCIES)
@rm -f dsdrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv3_OBJECTS) $(dsdrv3_LDADD) $(LIBS)
dsdrv4$(EXEEXT): $(dsdrv4_OBJECTS) $(dsdrv4_DEPENDENCIES) $(EXTRA_dsdrv4_DEPENDENCIES)
@rm -f dsdrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv4_OBJECTS) $(dsdrv4_LDADD) $(LIBS)
dsdrv5$(EXEEXT): $(dsdrv5_OBJECTS) $(dsdrv5_DEPENDENCIES) $(EXTRA_dsdrv5_DEPENDENCIES)
@rm -f dsdrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv5_OBJECTS) $(dsdrv5_LDADD) $(LIBS)
dsdrv6$(EXEEXT): $(dsdrv6_OBJECTS) $(dsdrv6_DEPENDENCIES) $(EXTRA_dsdrv6_DEPENDENCIES)
@rm -f dsdrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsdrv6_OBJECTS) $(dsdrv6_LDADD) $(LIBS)
ssdrv1$(EXEEXT): $(ssdrv1_OBJECTS) $(ssdrv1_DEPENDENCIES) $(EXTRA_ssdrv1_DEPENDENCIES)
@rm -f ssdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv1_OBJECTS) $(ssdrv1_LDADD) $(LIBS)
ssdrv2$(EXEEXT): $(ssdrv2_OBJECTS) $(ssdrv2_DEPENDENCIES) $(EXTRA_ssdrv2_DEPENDENCIES)
@rm -f ssdrv2$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv2_OBJECTS) $(ssdrv2_LDADD) $(LIBS)
ssdrv3$(EXEEXT): $(ssdrv3_OBJECTS) $(ssdrv3_DEPENDENCIES) $(EXTRA_ssdrv3_DEPENDENCIES)
@rm -f ssdrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv3_OBJECTS) $(ssdrv3_LDADD) $(LIBS)
ssdrv4$(EXEEXT): $(ssdrv4_OBJECTS) $(ssdrv4_DEPENDENCIES) $(EXTRA_ssdrv4_DEPENDENCIES)
@rm -f ssdrv4$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv4_OBJECTS) $(ssdrv4_LDADD) $(LIBS)
ssdrv5$(EXEEXT): $(ssdrv5_OBJECTS) $(ssdrv5_DEPENDENCIES) $(EXTRA_ssdrv5_DEPENDENCIES)
@rm -f ssdrv5$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv5_OBJECTS) $(ssdrv5_LDADD) $(LIBS)
ssdrv6$(EXEEXT): $(ssdrv6_OBJECTS) $(ssdrv6_DEPENDENCIES) $(EXTRA_ssdrv6_DEPENDENCIES)
@rm -f ssdrv6$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssdrv6_OBJECTS) $(ssdrv6_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dsdrv1.log: dsdrv1$(EXEEXT)
@p='dsdrv1$(EXEEXT)'; \
b='dsdrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv2.log: dsdrv2$(EXEEXT)
@p='dsdrv2$(EXEEXT)'; \
b='dsdrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv3.log: dsdrv3$(EXEEXT)
@p='dsdrv3$(EXEEXT)'; \
b='dsdrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv4.log: dsdrv4$(EXEEXT)
@p='dsdrv4$(EXEEXT)'; \
b='dsdrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv5.log: dsdrv5$(EXEEXT)
@p='dsdrv5$(EXEEXT)'; \
b='dsdrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
dsdrv6.log: dsdrv6$(EXEEXT)
@p='dsdrv6$(EXEEXT)'; \
b='dsdrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv1.log: ssdrv1$(EXEEXT)
@p='ssdrv1$(EXEEXT)'; \
b='ssdrv1'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv2.log: ssdrv2$(EXEEXT)
@p='ssdrv2$(EXEEXT)'; \
b='ssdrv2'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv3.log: ssdrv3$(EXEEXT)
@p='ssdrv3$(EXEEXT)'; \
b='ssdrv3'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv4.log: ssdrv4$(EXEEXT)
@p='ssdrv4$(EXEEXT)'; \
b='ssdrv4'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv5.log: ssdrv5$(EXEEXT)
@p='ssdrv5$(EXEEXT)'; \
b='ssdrv5'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssdrv6.log: ssdrv6$(EXEEXT)
@p='ssdrv6$(EXEEXT)'; \
b='ssdrv6'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv5.f 0000644 0001750 0001750 00000041250 12277373057 013567 0000000 0000000 program dsdrv5
c
c Program to illustrate the idea of reverse communication
c in Buckling mode for a generalized symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c dgttrf.f and dgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example five of ex-sym.doc in DOCUMENTS directory
c
c\Example-5
c ... Suppose we want to solve K*x = lambda*KG*x in Buckling mode
c where K and KG are obtained by the finite element of the
c 1-dimensional discrete Laplacian
c d^2u / dx^2
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c ... OP = (inv[K - sigma*KG])*K and B = K.
c ... Use mode 4 of DSAUPD.
c
c\BeginLib
c
c\References:
c 1. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c
c\Routines called:
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 dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector by a scalar.
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
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv5.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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),
& ax(maxn), mx(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& h, sigma, r1, r2, tol
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, two, four, six
parameter (zero = 0.0D+0, one = 1.0D+0,
& four = 4.0D+0, six = 6.0D+0,
& two = 2.0D+0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external daxpy, dcopy, dscal, dnrm2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable statements |
c %-----------------------%
c
c %--------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'.) NEV is the number of eigenvalues to be |
c | approximated. Since the buckling mode is used, |
c | WHICH is set to 'LM'. The user can modify NEV, |
c | NCV, SIGMA to solve problems of different sizes, |
c | and to get different parts of the spectrum. |
c | However, The following conditions must be |
c | satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c | |
c | The shift SIGMA cannot be zero!!! |
c %--------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV5: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV5: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV5: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
sigma = one
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 4 specified in the |
c | documentation of DSAUPD is used (IPARAM(7) = 4). |
c | All these options may be changed by the user. For |
c | details, see the documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 4
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %------------------------------------------------------%
c | Call LAPACK routine to factor the tridiagonal matrix |
c | (K-SIGMA*KG). The matrix A is the 1-d discrete |
c | Laplacian on the interval [0,1] with zero Dirichlet |
c | boundary condition. The matrix M is the associated |
c | mass matrix arising from using piecewise linear |
c | finite elements on the interval [0, 1]. |
c %------------------------------------------------------%
c
h = one / dble(n+1)
r1 = (four / six) * h
r2 = (one / six) * h
do 20 j=1,n
ad(j) = two / h - sigma * r1
adl(j) = -one / h- sigma * r2
20 continue
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 _SDRV5.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1) then
c
c %-------------------------------------------%
c | Perform y <--- OP*x = inv[K-SIGMA*KG]*K*x |
c | to force starting vector into the range |
c | of OP. The user should provide his/her |
c | matrix vector multiplication routine and |
c | a linear system solver here. The matrix |
c | vector multiplication routine (K*x) takes |
c | workd(ipntr(1)) as the input vector. The |
c | final result is returned to |
c | workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
c
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in SDRV5.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 1) then
c
c %------------------------------------------%
c | Perform y <-- OP*x=inv(K-sigma*KG)*K*x. |
c | K*x has been saved in workd(ipntr(3)). |
c | The user only needs the linear system |
c | solver here that takes workd(ipntr(3)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %------------------------------------------%
c
call dcopy ( n, workd(ipntr(3)), 1, workd(ipntr(2)), 1)
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV5.'
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if (ido .eq. 2) then
c
c %---------------------------------------------%
c | Perform y <--- K*x |
c | Need matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as input |
c | and returns the result to workd(ipntr(2)). |
c %---------------------------------------------%
c
call av (n, workd(ipntr(1)), workd(ipntr(2)))
c
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check the documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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
if (ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ',ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
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)
d(j,2) = d(j,2) / abs(d(j,1))
c
30 continue
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
c
end if
c
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV5 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is', n
print *, ' The number of Ritz values requested is', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv5. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1-dimensional mass matrix
c arising from using piecewise linear finite elements on the
c interval [0,1].
c
subroutine mv (n, v, w)
integer n, j
Double precision
& v(n),w(n), one, four, six, h
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
w(j) = v(j-1) + four*v(j) + v(j+1)
100 continue
j = n
w(j) = v(j-1) + four*v(j)
c
c Scale the vector w by h.
c
h = one / (six*dble(n+1))
call dscal(n, h, w, 1)
return
end
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the stiffness matrix obtained from the
c finite element discretization of the 1-dimensional discrete Laplacian
c on the interval [0,1] with zero Dirichlet boundary condition
c using piecewise linear elements.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, h
parameter (one = 1.0D+0, two = 2.0D+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1/h)
c
h = one / (n+1)
call dscal(n, one/h, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/SYM/dsdrv2.f 0000644 0001750 0001750 00000033300 12277373057 013561 0000000 0000000 program dsdrv2
c
c Program to illustrate the idea of reverse communication
c in shift and invert mode for a standard symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c dgttrf.f and dgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example two of ex-sym.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the central difference discretization
c of the 1-dimensional Laplacian on [0,1] with zero Dirichlet
c boundary condition.
c ... OP = (inv[A - sigma*I]) and B = I.
c ... Use mode 3 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 Ritz vectors.
c dgttrf LAPACK tridiagonal factorization routine.
c dgttrs LAPACK tridiagonal solve routine.
c daxpy daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& sigma, tol, h2
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, two
parameter (zero = 0.0D+0, one = 1.0D+0,
& two = 2.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external daxpy, dnrm2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = 'I'. |
c | NEV is the number of eigenvalues (closest to |
c | SIGMA) to be approximated. Since the shift-invert |
c | mode is used, WHICH is set to 'LM'. The user can |
c | modify NEV, NCV, SIGMA to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV2: NCV is greater than MAXNCV '
go to 9000
end if
c
bmat = 'I'
which = 'LM'
sigma = zero
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 DSAUPD is used |
c | (IPARAM(7) = 3). All these options may be |
c | changed by the user. For details, see the |
c | documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-----------------------------------------------------%
c | Call LAPACK routine to factor (A-SIGMA*I), where A |
c | is the 1-d Laplacian. |
c %-----------------------------------------------------%
c
h2 = one / dble((n+1)*(n+1))
do 20 j=1,n
ad(j) = two / h2 - sigma
adl(j) = -one / h2
20 continue
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 SDRV2.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*I]*x. |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(1)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %----------------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
c
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV2. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %----------------------------%
c | Error message. Check the |
c | documentation in DSAUPD |
c %----------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
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
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(n, v(1,j), ax)
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
30 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV2 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1 dimensional discrete Laplacian on
c the interval [0,1] with zero Dirichlet boundary condition.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, h2
parameter (one = 1.0D+0, two = 2.0D+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1 / h^2).
c
h2 = one / dble((n+1)*(n+1))
call dscal(n, one/h2, w, 1)
return
end
arpack-ng-3.1.5/EXAMPLES/Makefile.in 0000644 0001750 0001750 00000043734 12277667631 013623 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = EXAMPLES
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
SOURCES =
DIST_SOURCES =
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
distdir
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = BAND COMPLEX NONSYM SIMPLE SVD SYM
all: all-recursive
.SUFFIXES:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile
installdirs: installdirs-recursive
installdirs-am:
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-generic distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am:
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am:
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am:
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \
check-am clean clean-generic clean-libtool cscopelist-am ctags \
ctags-am distclean distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
installdirs-am maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SVD/ 0000755 0001750 0001750 00000000000 12277671461 012253 5 0000000 0000000 arpack-ng-3.1.5/EXAMPLES/SVD/debug.h 0000644 0001750 0001750 00000001351 12277373057 013432 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/EXAMPLES/SVD/README 0000644 0001750 0001750 00000001124 12277373057 013051 0000000 0000000 1. Purpose
-------
This directory contains simple example drivers that call ARPACK subroutine
[s,d]saupd.f and [s,d]seupd.f to compute the Singular Value Decomposition
of a matrix A. These drivers illustrate how to use ARPACK in considerable
detail.
2. Naming Convention
-----------------
The name for each driver has the form 'Xsvd.f', where
X - is 's' (single precision)
or 'd' (double precision)
3. Usage
-----
To run these drivers, you may use the makefile in this
directory and issue, for example, "make ssvd". Then
execute using "ssvd".
arpack-ng-3.1.5/EXAMPLES/SVD/Makefile.am 0000644 0001750 0001750 00000000323 12277671233 014222 0000000 0000000 check_PROGRAMS = dsvd ssvd
dsvd_SOURCES = dsvd.f
dsvd_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssvd_SOURCES = ssvd.f
ssvd_LDADD=../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = dsvd ssvd
arpack-ng-3.1.5/EXAMPLES/SVD/dsvd.f 0000644 0001750 0001750 00000052604 12277373057 013311 0000000 0000000 program dsvd
c
c This example program is intended to illustrate the
c the use of ARPACK to compute the Singular Value Decomposition.
c
c This code shows how to use ARPACK to find a few of the
c largest singular values(sigma) and corresponding right singular
c vectors (v) for the the matrix A by solving the symmetric problem:
c
c (A'*A)*v = sigma*v
c
c where A is an m by n real matrix.
c
c This code may be easily modified to estimate the 2-norm
c condition number largest(sigma)/smallest(sigma) by setting
c which = 'BE' below. This will ask for a few of the smallest
c and a few of the largest singular values simultaneously.
c The condition number could then be estimated by taking
c the ratio of the largest and smallest singular values.
c
c This formulation is appropriate when m .ge. n.
c Reverse the roles of A and A' in the case that m .le. n.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
c largest singular values of A .
c
c 2) Illustration of the reverse communication interface
c needed to utilize the top level ARPACK routine DSAUPD
c that computes the quantities needed to construct
c the desired singular values and vectors(if requested).
c
c 3) How to extract the desired singular values and vectors
c using the ARPACK routine DSEUPD.
c
c 4) How to construct the left singular vectors U from the
c right singular vectors V to obtain the decomposition
c
c A*V = U*S
c
c where S = diag(sigma_1, sigma_2, ..., sigma_k).
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
c appropriately, to specify WHICH singular values you want to
c compute and to supply a the matrix-vector products
c
c w <- Ax
c y <- A'w
c
c in place of the calls to AV( ) and ATV( ) respectively below.
c
c Further documentation is available in the header of DSAUPD
c which may be found in the SRC directory.
c
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A'A*v = sigma*v in regular mode,
c where A is derived from the simplest finite difference
c discretization of the 2-dimensional kernel K(s,t)dt where
c
c K(s,t) = s(t-1) if 0 .le. s .le. t .le. 1,
c t(s-1) if 0 .le. t .lt. s .le. 1.
c
c See subroutines AV and ATV for details.
c ... OP = A'*A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x
c ... Assume "call atv (n,y,w)" computes w = A'*y
c ... Assume exact shifts are used
c ...
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 Ritz vectors.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dscal Level 1 BLAS thst computes x <- x*alpha.
c dcopy Level 1 BLAS thst computes y <- x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: svd.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | It is assumed that A is M by N with M .ge. N. |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | M .le. MAXM and N .le. MAXN |
c | |
c | The NEV right singular vectors will be computed in |
c | the N by NCV array V. |
c | |
c | The NEV left singular vectors will be computed in |
c | the M by NEV array U. |
c | |
c | NEV is the number of singular values requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXM: Maximum number of rows of the A allowed. |
c | MAXN: Maximum number of columns of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %------------------------------------------------------%
c
integer maxm, maxn, maxnev, maxncv, ldv, ldu
parameter (maxm = 500, maxn=250, maxnev=10, maxncv=25,
& ldu = maxm, ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& v(ldv,maxncv), u(ldu, maxnev),
& workl(maxncv*(maxncv+8)), workd(3*maxn),
& s(maxncv,2), resid(maxn), ax(maxm)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, m, n, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
logical rvec
Double precision
& tol, sigma, temp
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0D+0, zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external dnrm2, daxpy, dcopy, dscal
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting msaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
msgets = 0
msaitr = 0
msapps = 0
msaupd = 1
msaup2 = 0
mseigt = 0
mseupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
m = 500
n = 100
c
c %------------------------------------------------%
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 singular values to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV singular values of |
c | largest magnitude |
c | (indicated by which = 'LM') |
c | See documentation in DSAUPD for the |
c | other options SM, BE. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %------------------------------------------------%
c
nev = 4
ncv = 10
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _SVD: N is greater than MAXN '
go to 9000
else if ( m .gt. maxm ) then
print *, ' ERROR with _SVD: M is greater than MAXM '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SVD: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SVD: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | Specification of stopping rules and initial |
c | conditions before calling DSAUPD |
c | |
c | abs(sigmaC - sigmaT) < TOL*abs(sigmaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 DSAUPD. (See usage below.) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to DSAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 DSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 DSAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = n
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse communication loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %---------------------------------------%
c | Perform matrix vector multiplications |
c | w <--- A*x (av()) |
c | y <--- A'*w (atv()) |
c | The user should supply his/her own |
c | matrix vector multiplication routines |
c | here that takes workd(ipntr(1)) as |
c | the input, and returns the result in |
c | workd(ipntr(2)). |
c %---------------------------------------%
c
call av (m, n, workd(ipntr(1)), ax)
call atv (m, n, ax, workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in DSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %--------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed singular values may be extracted. |
c | |
c | Singular vectors may also be computed now |
c | if desired. (indicated by rvec = .true.) |
c | |
c | The routine DSEUPD now called to do this |
c | post processing |
c %--------------------------------------------%
c
rvec = .true.
c
call dseupd ( rvec, 'All', select, s, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | Singular values are returned in the first |
c | column of the two dimensional array S |
c | and the corresponding right singular vectors |
c | are returned in the first NEV columns of the |
c | two dimensional array V as requested here. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
s(j,1) = sqrt(s(j,1))
c
c %-----------------------------%
c | Compute the left singular |
c | vectors from the formula |
c | |
c | u = Av/sigma |
c | |
c | u should have norm 1 so |
c | divide by norm(Av) instead. |
c %-----------------------------%
c
call av(m, n, v(1,j), ax)
call dcopy(m, ax, 1, u(1,j), 1)
temp = one/dnrm2(m, u(1,j), 1)
call dscal(m, temp, u(1,j), 1)
c
c %---------------------------%
c | |
c | Compute the residual norm |
c | |
c | || A*v - sigma*u || |
c | |
c | for the NCONV accurately |
c | computed singular values |
c | and vectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance). |
c | Store the result in 2nd |
c | column of array S. |
c %---------------------------%
c
call daxpy(m, -s(j,1), u(1,j), 1, ax, 1)
s(j,2) = dnrm2(m, ax, 1)
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call dmout(6, nconv, 2, s, maxncv, -6,
& 'Singular values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SVD '
print *, ' ==== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %-------------------------%
c | Done with program dsvd. |
c %-------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutines
c
c The matrix A is derived from the simplest finite difference
c discretization of the integral operator
c
c f(s) = integral(K(s,t)x(t)dt).
c
c Thus, the matrix A is a discretization of the 2-dimensional kernel
c K(s,t)dt, where
c
c K(s,t) = s(t-1) if 0 .le. s .le. t .le. 1,
c t(s-1) if 0 .le. t .lt. s .le. 1.
c
c Thus A is an m by n matrix with entries
c
c A(i,j) = k*(si)*(tj - 1) if i .le. j,
c k*(tj)*(si - 1) if i .gt. j
c
c where si = i/(m+1) and tj = j/(n+1) and k = 1/(n+1).
c
c-------------------------------------------------------------------
c
subroutine av (m, n, x, w)
c
c computes w <- A*x
c
integer m, n, i, j
Double precision
& x(n), w(m), one, zero, h, k, s, t
parameter ( one = 1.0D+0, zero = 0.0D+0 )
c
h = one / dble(m+1)
k = one / dble(n+1)
do 5 i = 1,m
w(i) = zero
5 continue
t = zero
c
do 30 j = 1,n
t = t+k
s = zero
do 10 i = 1,j
s = s+h
w(i) = w(i) + k*s*(t-one)*x(j)
10 continue
do 20 i = j+1,m
s = s+h
w(i) = w(i) + k*t*(s-one)*x(j)
20 continue
30 continue
c
return
end
c
c-------------------------------------------------------------------
c
subroutine atv (m, n, w, y)
c
c computes y <- A'*w
c
integer m, n, i, j
Double precision
& w(m), y(n), one, zero, h, k, s, t
parameter ( one = 1.0D+0, zero = 0.0D+0 )
c
h = one / dble(m+1)
k = one / dble(n+1)
do 5 i = 1,n
y(i) = zero
5 continue
t = zero
c
do 30 j = 1,n
t = t+k
s = zero
do 10 i = 1,j
s = s+h
y(j) = y(j) + k*s*(t-one)*w(i)
10 continue
do 20 i = j+1,m
s = s+h
y(j) = y(j) + k*t*(s-one)*w(i)
20 continue
30 continue
c
return
end
c
arpack-ng-3.1.5/EXAMPLES/SVD/Makefile 0000644 0001750 0001750 00000075240 12277671461 013643 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# EXAMPLES/SVD/Makefile. Generated from Makefile.in by configure.
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/arpack-ng
pkgincludedir = $(includedir)/arpack-ng
pkglibdir = $(libdir)/arpack-ng
pkglibexecdir = $(libexecdir)/arpack-ng
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = x86_64-unknown-linux-gnu
host_triplet = x86_64-unknown-linux-gnu
check_PROGRAMS = dsvd$(EXEEXT) ssvd$(EXEEXT)
TESTS = dsvd$(EXEEXT) ssvd$(EXEEXT)
subdir = EXAMPLES/SVD
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dsvd_OBJECTS = dsvd.$(OBJEXT)
dsvd_OBJECTS = $(am_dsvd_OBJECTS)
am__DEPENDENCIES_1 =
dsvd_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_$(V))
am__v_lt_ = $(am__v_lt_$(AM_DEFAULT_VERBOSITY))
am__v_lt_0 = --silent
am__v_lt_1 =
am_ssvd_OBJECTS = ssvd.$(OBJEXT)
ssvd_OBJECTS = $(am_ssvd_OBJECTS)
ssvd_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_$(V))
am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY))
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_$(V))
am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY))
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_$(V))
am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY))
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_$(V))
am__v_F77_ = $(am__v_F77_$(AM_DEFAULT_VERBOSITY))
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_$(V))
am__v_F77LD_ = $(am__v_F77LD_$(AM_DEFAULT_VERBOSITY))
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dsvd_SOURCES) $(ssvd_SOURCES)
DIST_SOURCES = $(dsvd_SOURCES) $(ssvd_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing aclocal-1.14
AMTAR = $${TAR-tar}
AM_DEFAULT_VERBOSITY = 1
AR = ar
AS = as
AUTOCONF = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoconf
AUTOHEADER = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing autoheader
AUTOMAKE = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing automake-1.14
AWK = gawk
BLAS_LIBS = -lblas
CC = gcc
CCDEPMODE = depmode=gcc3
CFLAGS = -g -O2
CPP = gcc -E
CPPFLAGS =
CYGPATH_W = echo
DEFS = -DPACKAGE_NAME=\"arpack-ng\" -DPACKAGE_TARNAME=\"arpack-ng\" -DPACKAGE_VERSION=\"3.1.5\" -DPACKAGE_STRING=\"arpack-ng\ 3.1.5\" -DPACKAGE_BUGREPORT=\"http://forge.scilab.org/index.php/p/arpack-ng/issues/\" -DPACKAGE_URL=\"\" -DPACKAGE=\"arpack-ng\" -DVERSION=\"3.1.5\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_DLFCN_H=1 -DLT_OBJDIR=\".libs/\" -DHAVE_BLAS=1 -DHAVE_LAPACK=1
DEPDIR = .deps
DLLTOOL = false
DSYMUTIL =
DUMPBIN =
ECHO_C =
ECHO_N = -n
ECHO_T =
EGREP = /bin/grep -E
EXEEXT =
F77 = gfortran
FFLAGS = -g -O2
FGREP = /bin/grep -F
FLIBS = -L/usr/lib/gcc/x86_64-linux-gnu/4.8 -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../x86_64-linux-gnu -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../../../lib -L/lib/x86_64-linux-gnu -L/lib/../lib -L/usr/lib/x86_64-linux-gnu -L/usr/lib/../lib -L/usr/lib/gcc/x86_64-linux-gnu/4.8/../../.. -lgfortran -lm -lquadmath
GREP = /bin/grep
INSTALL = /usr/bin/install -c
INSTALL_DATA = ${INSTALL} -m 644
INSTALL_PROGRAM = ${INSTALL}
INSTALL_SCRIPT = ${INSTALL}
INSTALL_STRIP_PROGRAM = $(install_sh) -c -s
LAPACK_LIBS = -llapack
LD = /usr/bin/ld -m elf_x86_64
LDFLAGS =
LIBOBJS =
LIBS =
LIBTOOL = $(SHELL) $(top_builddir)/libtool
LIPO =
LN_S = ln -s
LTLIBOBJS =
MAINT =
MAKEINFO = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/missing makeinfo
MANIFEST_TOOL = :
MKDIR_P = /bin/mkdir -p
MPIF77 =
MPILIBS =
NM = /usr/bin/nm -B
NMEDIT =
OBJDUMP = objdump
OBJEXT = o
OTOOL =
OTOOL64 =
PACKAGE = arpack-ng
PACKAGE_BUGREPORT = http://forge.scilab.org/index.php/p/arpack-ng/issues/
PACKAGE_NAME = arpack-ng
PACKAGE_STRING = arpack-ng 3.1.5
PACKAGE_TARNAME = arpack-ng
PACKAGE_URL =
PACKAGE_VERSION = 3.1.5
PATH_SEPARATOR = :
RANLIB = ranlib
SED = /bin/sed
SET_MAKE =
SHELL = /bin/bash
STRIP = strip
VERSION = 3.1.5
abs_builddir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SVD
abs_srcdir = /home/sylvestre/dev/debian/arpack-ng/EXAMPLES/SVD
abs_top_builddir = /home/sylvestre/dev/debian/arpack-ng
abs_top_srcdir = /home/sylvestre/dev/debian/arpack-ng
ac_ct_AR = ar
ac_ct_CC = gcc
ac_ct_DUMPBIN =
ac_ct_F77 = gfortran
am__include = include
am__leading_dot = .
am__quote =
am__tar = $${TAR-tar} chof - "$$tardir"
am__untar = $${TAR-tar} xf -
bindir = ${exec_prefix}/bin
build = x86_64-unknown-linux-gnu
build_alias =
build_cpu = x86_64
build_os = linux-gnu
build_vendor = unknown
builddir = .
datadir = ${datarootdir}
datarootdir = ${prefix}/share
docdir = ${datarootdir}/doc/${PACKAGE_TARNAME}
dvidir = ${docdir}
exec_prefix = ${prefix}
host = x86_64-unknown-linux-gnu
host_alias =
host_cpu = x86_64
host_os = linux-gnu
host_vendor = unknown
htmldir = ${docdir}
includedir = ${prefix}/include
infodir = ${datarootdir}/info
install_sh = ${SHELL} /home/sylvestre/dev/debian/arpack-ng/install-sh
libdir = ${exec_prefix}/lib
libexecdir = ${exec_prefix}/libexec
localedir = ${datarootdir}/locale
localstatedir = ${prefix}/var
mandir = ${datarootdir}/man
mkdir_p = $(MKDIR_P)
oldincludedir = /usr/include
pdfdir = ${docdir}
prefix = /usr/local
program_transform_name = s,x,x,
psdir = ${docdir}
sbindir = ${exec_prefix}/sbin
sharedstatedir = ${prefix}/com
srcdir = .
sysconfdir = ${prefix}/etc
target_alias =
top_build_prefix = ../../
top_builddir = ../..
top_srcdir = ../..
dsvd_SOURCES = dsvd.f
dsvd_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssvd_SOURCES = ssvd.f
ssvd_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SVD/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SVD/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dsvd$(EXEEXT): $(dsvd_OBJECTS) $(dsvd_DEPENDENCIES) $(EXTRA_dsvd_DEPENDENCIES)
@rm -f dsvd$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsvd_OBJECTS) $(dsvd_LDADD) $(LIBS)
ssvd$(EXEEXT): $(ssvd_OBJECTS) $(ssvd_DEPENDENCIES) $(EXTRA_ssvd_DEPENDENCIES)
@rm -f ssvd$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssvd_OBJECTS) $(ssvd_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dsvd.log: dsvd$(EXEEXT)
@p='dsvd$(EXEEXT)'; \
b='dsvd'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssvd.log: ssvd$(EXEEXT)
@p='ssvd$(EXEEXT)'; \
b='ssvd'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
#.test$(EXEEXT).log:
# @p='$<'; \
# $(am__set_b); \
# $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
# --log-file $$b.log --trs-file $$b.trs \
# $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
# "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SVD/Makefile.in 0000644 0001750 0001750 00000073401 12277671235 014244 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = dsvd$(EXEEXT) ssvd$(EXEEXT)
TESTS = dsvd$(EXEEXT) ssvd$(EXEEXT)
subdir = EXAMPLES/SVD
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver README
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_dsvd_OBJECTS = dsvd.$(OBJEXT)
dsvd_OBJECTS = $(am_dsvd_OBJECTS)
am__DEPENDENCIES_1 =
dsvd_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_ssvd_OBJECTS = ssvd.$(OBJEXT)
ssvd_OBJECTS = $(am_ssvd_OBJECTS)
ssvd_DEPENDENCIES = ../../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(dsvd_SOURCES) $(ssvd_SOURCES)
DIST_SOURCES = $(dsvd_SOURCES) $(ssvd_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
dsvd_SOURCES = dsvd.f
dsvd_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
ssvd_SOURCES = ssvd.f
ssvd_LDADD = ../../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign EXAMPLES/SVD/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign EXAMPLES/SVD/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
dsvd$(EXEEXT): $(dsvd_OBJECTS) $(dsvd_DEPENDENCIES) $(EXTRA_dsvd_DEPENDENCIES)
@rm -f dsvd$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dsvd_OBJECTS) $(dsvd_LDADD) $(LIBS)
ssvd$(EXEEXT): $(ssvd_OBJECTS) $(ssvd_DEPENDENCIES) $(EXTRA_ssvd_DEPENDENCIES)
@rm -f ssvd$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(ssvd_OBJECTS) $(ssvd_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dsvd.log: dsvd$(EXEEXT)
@p='dsvd$(EXEEXT)'; \
b='dsvd'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
ssvd.log: ssvd$(EXEEXT)
@p='ssvd$(EXEEXT)'; \
b='ssvd'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/EXAMPLES/SVD/ssvd.f 0000644 0001750 0001750 00000052474 12277373057 013335 0000000 0000000 program ssvd
c
c This example program is intended to illustrate the
c the use of ARPACK to compute the Singular Value Decomposition.
c
c This code shows how to use ARPACK to find a few of the
c largest singular values(sigma) and corresponding right singular
c vectors (v) for the the matrix A by solving the symmetric problem:
c
c (A'*A)*v = sigma*v
c
c where A is an m by n real matrix.
c
c This code may be easily modified to estimate the 2-norm
c condition number largest(sigma)/smallest(sigma) by setting
c which = 'BE' below. This will ask for a few of the smallest
c and a few of the largest singular values simultaneously.
c The condition number could then be estimated by taking
c the ratio of the largest and smallest singular values.
c
c This formulation is appropriate when m .ge. n.
c Reverse the roles of A and A' in the case that m .le. n.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
c largest singular values of A .
c
c 2) Illustration of the reverse communication interface
c needed to utilize the top level ARPACK routine SSAUPD
c that computes the quantities needed to construct
c the desired singular values and vectors(if requested).
c
c 3) How to extract the desired singular values and vectors
c using the ARPACK routine SSEUPD.
c
c 4) How to construct the left singular vectors U from the
c right singular vectors V to obtain the decomposition
c
c A*V = U*S
c
c where S = diag(sigma_1, sigma_2, ..., sigma_k).
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
c appropriately, to specify WHICH singular values you want to
c compute and to supply a the matrix-vector products
c
c w <- Ax
c y <- A'w
c
c in place of the calls to AV( ) and ATV( ) respectively below.
c
c Further documentation is available in the header of DSAUPD
c which may be found in the SRC directory.
c
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A'A*v = sigma*v in regular mode,
c where A is derived from the simplest finite difference
c discretization of the 2-dimensional kernel K(s,t)dt where
c
c K(s,t) = s(t-1) if 0 .le. s .le. t .le. 1,
c t(s-1) if 0 .le. t .lt. s .le. 1.
c
c See subroutines AV and ATV for details.
c ... OP = A'*A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x
c ... Assume "call atv (n,y,w)" computes w = A'*y
c ... Assume exact shifts are used
c ...
c
c\BeginLib
c
c\Routines called:
c ssaupd ARPACK reverse communication interface routine.
c sseupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c sscal Level 1 BLAS thst computes x <- x*alpha.
c scopy Level 1 BLAS thst computes y <- x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: svd.F SID: 2.4 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | It is assumed that A is M by N with M .ge. N. |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | M .le. MAXM and N .le. MAXN |
c | |
c | The NEV right singular vectors will be computed in |
c | the N by NCV array V. |
c | |
c | The NEV left singular vectors will be computed in |
c | the M by NEV array U. |
c | |
c | NEV is the number of singular values requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXM: Maximum number of rows of the A allowed. |
c | MAXN: Maximum number of columns of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %------------------------------------------------------%
c
integer maxm, maxn, maxnev, maxncv, ldv, ldu
parameter (maxm = 500, maxn=250, maxnev=10, maxncv=25,
& ldu = maxm, ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), u(ldu, maxnev),
& workl(maxncv*(maxncv+8)), workd(3*maxn),
& s(maxncv,2), resid(maxn), ax(maxm)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, m, n, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
logical rvec
Real
& tol, sigma, temp
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0E+0, zero = 0.0E+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& snrm2
external snrm2, saxpy, scopy, sscal
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting msaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
msgets = 0
msaitr = 0
msapps = 0
msaupd = 1
msaup2 = 0
mseigt = 0
mseupd = 0
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
m = 500
n = 100
c
c %------------------------------------------------%
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 singular values to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization |
c | |
c | 3) This is a standard problem |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV singular values of |
c | largest magnitude |
c | (indicated by which = 'LM') |
c | See documentation in SSAUPD for the |
c | other options SM, BE. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %------------------------------------------------%
c
nev = 4
ncv = 10
bmat = 'I'
which = 'LM'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _SVD: N is greater than MAXN '
go to 9000
else if ( m .gt. maxm ) then
print *, ' ERROR with _SVD: M is greater than MAXM '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SVD: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SVD: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | Specification of stopping rules and initial |
c | conditions before calling SSAUPD |
c | |
c | abs(sigmaC - sigmaT) < TOL*abs(sigmaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 SSAUPD. (See usage below.) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to SSAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 SSAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c %-----------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 SSAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | SSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = n
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %------------------------------------------------%
c | M A I N L O O P (Reverse communication loop) |
c %------------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SSAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call ssaupd ( ido, bmat, n, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %---------------------------------------%
c | Perform matrix vector multiplications |
c | w <--- A*x (av()) |
c | y <--- A'*w (atv()) |
c | The user should supply his/her own |
c | matrix vector multiplication routines |
c | here that takes workd(ipntr(1)) as |
c | the input, and returns the result in |
c | workd(ipntr(2)). |
c %---------------------------------------%
c
call av (m, n, workd(ipntr(1)), ax)
call atv (m, n, ax, workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in SSAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
c
else
c
c %--------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SSEUPD. |
c | |
c | Computed singular values may be extracted. |
c | |
c | Singular vectors may also be computed now |
c | if desired. (indicated by rvec = .true.) |
c | |
c | The routine SSEUPD now called to do this |
c | post processing |
c %--------------------------------------------%
c
rvec = .true.
c
call sseupd ( rvec, 'All', select, s, v, ldv, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | Singular values are returned in the first |
c | column of the two dimensional array S |
c | and the corresponding right singular vectors |
c | are returned in the first NEV columns of the |
c | two dimensional array V as requested here. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
s(j,1) = sqrt(s(j,1))
c
c %-----------------------------%
c | Compute the left singular |
c | vectors from the formula |
c | |
c | u = Av/sigma |
c | |
c | u should have norm 1 so |
c | divide by norm(Av) instead. |
c %-----------------------------%
c
call av(m, n, v(1,j), ax)
call scopy(m, ax, 1, u(1,j), 1)
temp = one/snrm2(m, u(1,j), 1)
call sscal(m, temp, u(1,j), 1)
c
c %---------------------------%
c | |
c | Compute the residual norm |
c | |
c | || A*v - sigma*u || |
c | |
c | for the NCONV accurately |
c | computed singular values |
c | and vectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance). |
c | Store the result in 2nd |
c | column of array S. |
c %---------------------------%
c
call saxpy(m, -s(j,1), u(1,j), 1, ax, 1)
s(j,2) = snrm2(m, ax, 1)
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call smout(6, nconv, 2, s, maxncv, -6,
& 'Singular values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SVD '
print *, ' ==== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %-------------------------%
c | Done with program ssvd. |
c %-------------------------%
c
9000 continue
c
end
c
c ------------------------------------------------------------------
c matrix vector subroutines
c
c The matrix A is derived from the simplest finite difference
c discretization of the integral operator
c
c f(s) = integral(K(s,t)x(t)dt).
c
c Thus, the matrix A is a discretization of the 2-dimensional kernel
c K(s,t)dt, where
c
c K(s,t) = s(t-1) if 0 .le. s .le. t .le. 1,
c t(s-1) if 0 .le. t .lt. s .le. 1.
c
c Thus A is an m by n matrix with entries
c
c A(i,j) = k*(si)*(tj - 1) if i .le. j,
c k*(tj)*(si - 1) if i .gt. j
c
c where si = i/(m+1) and tj = j/(n+1) and k = 1/(n+1).
c
c-------------------------------------------------------------------
c
subroutine av (m, n, x, w)
c
c computes w <- A*x
c
integer m, n, i, j
Real
& x(n), w(m), one, zero, h, k, s, t
parameter ( one = 1.0E+0, zero = 0.0E+0 )
c
h = one / real(m+1)
k = one / real(n+1)
do 5 i = 1,m
w(i) = zero
5 continue
t = zero
c
do 30 j = 1,n
t = t+k
s = zero
do 10 i = 1,j
s = s+h
w(i) = w(i) + k*s*(t-one)*x(j)
10 continue
do 20 i = j+1,m
s = s+h
w(i) = w(i) + k*t*(s-one)*x(j)
20 continue
30 continue
c
return
end
c
c-------------------------------------------------------------------
c
subroutine atv (m, n, w, y)
c
c computes y <- A'*w
c
integer m, n, i, j
Real
& w(m), y(n), one, zero, h, k, s, t
parameter ( one = 1.0E+0, zero = 0.0E+0 )
c
h = one / real(m+1)
k = one / real(n+1)
do 5 i = 1,n
y(i) = zero
5 continue
t = zero
c
do 30 j = 1,n
t = t+k
s = zero
do 10 i = 1,j
s = s+h
y(j) = y(j) + k*s*(t-one)*w(i)
10 continue
do 20 i = j+1,m
s = s+h
y(j) = y(j) + k*t*(s-one)*w(i)
20 continue
30 continue
c
return
end
c
arpack-ng-3.1.5/TODO 0000644 0001750 0001750 00000000072 12277373057 011010 0000000 0000000 * add a version somewhere to allow configure to detect it
arpack-ng-3.1.5/UTIL/ 0000755 0001750 0001750 00000000000 12277671743 011161 5 0000000 0000000 arpack-ng-3.1.5/UTIL/cmout.f 0000644 0001750 0001750 00000021063 12277373057 012376 0000000 0000000 *
* Routine: CMOUT
*
* Purpose: Complex matrix output routine.
*
* Usage: CALL CMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information: @(#)
* FILE: cmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
*
*-----------------------------------------------------------------------
*
SUBROUTINE CMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,
& ') '))
*
*
*
*
RETURN
END
arpack-ng-3.1.5/UTIL/icnteq.f 0000644 0001750 0001750 00000000604 12277373057 012530 0000000 0000000 c
c-----------------------------------------------------------------------
c
c Count the number of elements equal to a specified integer value.
c
integer function icnteq (n, array, value)
c
integer n, value
integer array(*)
c
k = 0
do 10 i = 1, n
if (array(i) .eq. value) k = k + 1
10 continue
icnteq = k
c
return
end
arpack-ng-3.1.5/UTIL/Makefile.am 0000644 0001750 0001750 00000000343 12277373057 013132 0000000 0000000 noinst_LTLIBRARIES = libarpackutil.la
libarpackutil_la_SOURCES = \
icnteq.f icopy.f iset.f iswap.f ivout.f second_NONE.f \
svout.f smout.f dvout.f dmout.f cvout.f cmout.f \
zvout.f zmout.f
EXTRA_DIST=second.f second.t3d
arpack-ng-3.1.5/UTIL/cvout.f 0000644 0001750 0001750 00000020015 12277373057 012403 0000000 0000000 c-----------------------------------------------------------------------
c
c\SCCS Information: @(#)
c FILE: cvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
c
*-----------------------------------------------------------------------
* Routine: CVOUT
*
* Purpose: Complex vector output routine.
*
* Usage: CALL CVOUT (LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* N - Length of array CX. (Input)
* CX - Complex array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE CVOUT( LOUT, N, CX, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',E10.3,',',E10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E10.3,',',E10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E12.5,',',E12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E14.7,',',E14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E20.13,',',E20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/UTIL/second.t3d 0000644 0001750 0001750 00000000130 12277373057 012757 0000000 0000000 subroutine second(t)
real t
t = rtc()*6.67E-09
return
end
arpack-ng-3.1.5/UTIL/second.f 0000644 0001750 0001750 00000001414 12277373057 012520 0000000 0000000 SUBROUTINE ARSCND( T )
*
REAL T
*
* -- LAPACK auxiliary routine (preliminary version) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* July 26, 1991
*
* Purpose
* =======
*
* SECOND returns the user time for a process in seconds.
* This version gets the time from the system function ETIME.
*
* .. Local Scalars ..
REAL T1
* ..
* .. Local Arrays ..
REAL TARRAY( 2 )
* ..
* .. External Functions ..
REAL ETIME
INTRINSIC ETIME
* ..
* .. Executable Statements ..
*
T1 = ETIME( TARRAY )
T = TARRAY( 1 )
RETURN
*
* End of ARSCND
*
END
arpack-ng-3.1.5/UTIL/icopy.f 0000644 0001750 0001750 00000003635 12277373057 012377 0000000 0000000 *--------------------------------------------------------------------
*\Documentation
*
*\Name: ICOPY
*
*\Description:
* ICOPY copies an integer vector lx to an integer vector ly.
*
*\Usage:
* call icopy ( n, lx, inc, ly, incy )
*
*\Arguments:
* n integer (input)
* On entry, n is the number of elements of lx to be
c copied to ly.
*
* lx integer array (input)
* On entry, lx is the integer vector to be copied.
*
* incx integer (input)
* On entry, incx is the increment between elements of lx.
*
* ly integer array (input)
* On exit, ly is the integer vector that contains the
* copy of lx.
*
* incy integer (input)
* On entry, incy is the increment between elements of ly.
*
*\Enddoc
*
*--------------------------------------------------------------------
*
subroutine icopy( n, lx, incx, ly, incy )
*
* ----------------------------
* Specifications for arguments
* ----------------------------
integer incx, incy, n
integer lx( 1 ), ly( 1 )
*
* ----------------------------------
* Specifications for local variables
* ----------------------------------
integer i, ix, iy
*
* --------------------------
* First executable statement
* --------------------------
if( n.le.0 )
$ return
if( incx.eq.1 .and. incy.eq.1 )
$ go to 20
c
c.....code for unequal increments or equal increments
c not equal to 1
ix = 1
iy = 1
if( incx.lt.0 )
$ ix = ( -n+1 )*incx + 1
if( incy.lt.0 )
$ iy = ( -n+1 )*incy + 1
do 10 i = 1, n
ly( iy ) = lx( ix )
ix = ix + incx
iy = iy + incy
10 continue
return
c
c.....code for both increments equal to 1
c
20 continue
do 30 i = 1, n
ly( i ) = lx( i )
30 continue
return
end
arpack-ng-3.1.5/UTIL/svout.f 0000644 0001750 0001750 00000007144 12277373057 012433 0000000 0000000 *-----------------------------------------------------------------------
* Routine: SVOUT
*
* Purpose: Real vector output routine.
*
* Usage: CALL SVOUT (LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* N - Length of array SX. (Input)
* SX - Real array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE SVOUT( LOUT, N, SX, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
REAL SX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P10E12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P8E14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P6E18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P5E24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/UTIL/iswap.f 0000644 0001750 0001750 00000002313 12277373057 012367 0000000 0000000 subroutine iswap (n,sx,incx,sy,incy)
c
c interchanges two vectors.
c uses unrolled loops for increments equal to 1.
c jack dongarra, linpack, 3/11/78.
c
integer sx(1),sy(1),stemp
integer i,incx,incy,ix,iy,m,mp1,n
c
if(n.le.0)return
if(incx.eq.1.and.incy.eq.1)go to 20
c
c code for unequal increments or equal increments not equal
c to 1
c
ix = 1
iy = 1
if(incx.lt.0)ix = (-n+1)*incx + 1
if(incy.lt.0)iy = (-n+1)*incy + 1
do 10 i = 1,n
stemp = sx(ix)
sx(ix) = sy(iy)
sy(iy) = stemp
ix = ix + incx
iy = iy + incy
10 continue
return
c
c code for both increments equal to 1
c
c
c clean-up loop
c
20 m = mod(n,3)
if( m .eq. 0 ) go to 40
do 30 i = 1,m
stemp = sx(i)
sx(i) = sy(i)
sy(i) = stemp
30 continue
if( n .lt. 3 ) return
40 mp1 = m + 1
do 50 i = mp1,n,3
stemp = sx(i)
sx(i) = sy(i)
sy(i) = stemp
stemp = sx(i + 1)
sx(i + 1) = sy(i + 1)
sy(i + 1) = stemp
stemp = sx(i + 2)
sx(i + 2) = sy(i + 2)
sy(i + 2) = stemp
50 continue
return
end
arpack-ng-3.1.5/UTIL/ivout.f 0000644 0001750 0001750 00000006457 12277373057 012427 0000000 0000000 C-----------------------------------------------------------------------
C Routine: IVOUT
C
C Purpose: Integer vector output routine.
C
C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
C
C Arguments
C N - Length of array IX. (Input)
C IX - Integer array to be printed. (Input)
C IFMT - Format to be used in printing array IX. (Input)
C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
C If IDIGIT .LT. 0, printing is done with 72 columns.
C If IDIGIT .GT. 0, printing is done with 132 columns.
C
C-----------------------------------------------------------------------
C
SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
C ...
C ... SPECIFICATIONS FOR ARGUMENTS
INTEGER IX(*), N, IDIGIT, LOUT
CHARACTER IFMT*(*)
C ...
C ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
C
LLL = MIN ( LEN ( IFMT ), 80 )
DO 1 I = 1, LLL
LINE(I:I) = '-'
1 CONTINUE
C
DO 2 I = LLL+1, 80
LINE(I:I) = ' '
2 CONTINUE
C
WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
2000 FORMAT ( /1X, A /1X, A )
C
IF (N .LE. 0) RETURN
NDIGIT = IDIGIT
IF (IDIGIT .EQ. 0) NDIGIT = 4
C
C=======================================================================
C CODE FOR OUTPUT USING 72 COLUMNS FORMAT
C=======================================================================
C
IF (IDIGIT .LT. 0) THEN
C
NDIGIT = -IDIGIT
IF (NDIGIT .LE. 4) THEN
DO 10 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
10 CONTINUE
C
ELSE IF (NDIGIT .LE. 6) THEN
DO 30 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
30 CONTINUE
C
ELSE IF (NDIGIT .LE. 10) THEN
DO 50 K1 = 1, N, 5
K2 = MIN0(N,K1+4)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
50 CONTINUE
C
ELSE
DO 70 K1 = 1, N, 3
K2 = MIN0(N,K1+2)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
70 CONTINUE
END IF
C
C=======================================================================
C CODE FOR OUTPUT USING 132 COLUMNS FORMAT
C=======================================================================
C
ELSE
C
IF (NDIGIT .LE. 4) THEN
DO 90 K1 = 1, N, 20
K2 = MIN0(N,K1+19)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
90 CONTINUE
C
ELSE IF (NDIGIT .LE. 6) THEN
DO 110 K1 = 1, N, 15
K2 = MIN0(N,K1+14)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
110 CONTINUE
C
ELSE IF (NDIGIT .LE. 10) THEN
DO 130 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
130 CONTINUE
C
ELSE
DO 150 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
150 CONTINUE
END IF
END IF
WRITE (LOUT,1004)
C
1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
1004 FORMAT(1X,' ')
C
RETURN
END
arpack-ng-3.1.5/UTIL/zvout.f 0000644 0001750 0001750 00000020026 12277373057 012434 0000000 0000000 c-----------------------------------------------------------------------
c
c\SCCS Information: @(#)
c FILE: zvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
c
*-----------------------------------------------------------------------
* Routine: ZVOUT
*
* Purpose: Complex*16 vector output routine.
*
* Usage: CALL ZVOUT (LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* N - Length of array CX. (Input)
* CX - Complex*16 array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE ZVOUT( LOUT, N, CX, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex*16
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',D10.3,',',D10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D10.3,',',D10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D12.5,',',D12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D14.7,',',D14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D20.13,',',D20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/UTIL/Makefile.in 0000644 0001750 0001750 00000037615 12277667632 013164 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = UTIL
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libarpackutil_la_LIBADD =
am_libarpackutil_la_OBJECTS = icnteq.lo icopy.lo iset.lo iswap.lo \
ivout.lo second_NONE.lo svout.lo smout.lo dvout.lo dmout.lo \
cvout.lo cmout.lo zvout.lo zmout.lo
libarpackutil_la_OBJECTS = $(am_libarpackutil_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libarpackutil_la_SOURCES)
DIST_SOURCES = $(libarpackutil_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libarpackutil.la
libarpackutil_la_SOURCES = \
icnteq.f icopy.f iset.f iswap.f ivout.f second_NONE.f \
svout.f smout.f dvout.f dmout.f cvout.f cmout.f \
zvout.f zmout.f
EXTRA_DIST = second.f second.t3d
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign UTIL/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign UTIL/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libarpackutil.la: $(libarpackutil_la_OBJECTS) $(libarpackutil_la_DEPENDENCIES) $(EXTRA_libarpackutil_la_DEPENDENCIES)
$(AM_V_F77LD)$(F77LINK) $(libarpackutil_la_OBJECTS) $(libarpackutil_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/UTIL/smout.f 0000644 0001750 0001750 00000012145 12277373057 012417 0000000 0000000 *-----------------------------------------------------------------------
* Routine: SMOUT
*
* Purpose: Real matrix output routine.
*
* Usage: CALL SMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Real M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE SMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
REAL A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P10E12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P8E14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P6E18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P5E22.13 )
9990 FORMAT( 1X, ' ' )
*
RETURN
END
arpack-ng-3.1.5/UTIL/dmout.f 0000644 0001750 0001750 00000012657 12277373057 012410 0000000 0000000 *-----------------------------------------------------------------------
* Routine: DMOUT
*
* Purpose: Real matrix output routine.
*
* Usage: CALL DMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Real M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE DMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LDA, LOUT, M, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, J, K1, K2, LLL, NDIGIT
* ..
* .. Local Arrays ..
CHARACTER ICOL( 3 )
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Data statements ..
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 )
9990 FORMAT( 1X, ' ' )
*
RETURN
END
arpack-ng-3.1.5/UTIL/iset.f 0000644 0001750 0001750 00000000505 12277373057 012211 0000000 0000000 c
c-----------------------------------------------------------------------
c
c Only work with increment equal to 1 right now.
c
subroutine iset (n, value, array, inc)
c
integer n, value, inc
integer array(*)
c
do 10 i = 1, n
array(i) = value
10 continue
c
return
end
arpack-ng-3.1.5/UTIL/second_NONE.f 0000644 0001750 0001750 00000001431 12277373057 013336 0000000 0000000 SUBROUTINE ARSCND( T )
*
REAL T
*
* -- LAPACK auxiliary routine (preliminary version) --
* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
* Courant Institute, Argonne National Lab, and Rice University
* July 26, 1991
*
* Purpose
* =======
*
* SECOND returns the user time for a process in arscnds.
* This version gets the time from the system function ETIME.
*
* .. Local Scalars ..
REAL T1
* ..
* .. Local Arrays ..
REAL TARRAY( 2 )
* ..
* .. External Functions ..
REAL ETIME
EXTERNAL ETIME
* ..
* .. Executable Statements ..
*
c T1 = ETIME( TARRAY )
c T = TARRAY( 1 )
T = 0
RETURN
*
* End of ARSCND
*
END
arpack-ng-3.1.5/UTIL/zmout.f 0000644 0001750 0001750 00000021074 12277373057 012427 0000000 0000000 *
* Routine: ZMOUT
*
* Purpose: Complex*16 matrix output routine.
*
* Usage: CALL ZMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex*16 M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information: @(#)
* FILE: zmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
*
*-----------------------------------------------------------------------
*
SUBROUTINE ZMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex*16
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',D10.3,',',D10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D10.3,',',D10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D12.5,',',D12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D14.7,',',D14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D20.13,',',D20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,
& ') '))
*
*
*
*
RETURN
END
arpack-ng-3.1.5/UTIL/dvout.f 0000644 0001750 0001750 00000007604 12277373057 012415 0000000 0000000 *-----------------------------------------------------------------------
* Routine: DVOUT
*
* Purpose: Real vector output routine.
*
* Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* N - Length of array SX. (Input)
* SX - Real array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*-----------------------------------------------------------------------
*
SUBROUTINE DVOUT( LOUT, N, SX, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LOUT, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION SX( * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, K1, K2, LLL, NDIGIT
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9994 )
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/detect_arpack_bug.m4 0000644 0001750 0001750 00000011073 12277373057 014213 0000000 0000000 dnl
dnl Check whether ARPACK works (does not crash)
dnl
dnl Using a pure Fortran program doesn't seem to crash when linked
dnl with the buggy ARPACK library but the C++ program does. Maybe
dnl it is the memory allocation that exposes the bug and using statically
dnl allocated arrays in Fortran does not?
dnl
dnl This code is not used by arpack-ng itself.
dnl This is a macro for applications using arpack to detect that the version
dnl of arpack behave correcly (ie not arpack-ng)
dnl This is the work of Rik
dnl
dnl This code is released under the same license as arpack
dnl
AC_DEFUN([CHECK_ARPACK_OK], [
AC_LANG_PUSH(C++)
AC_CACHE_CHECK([whether the arpack library works],
[cv_lib_arpack_ok], [
AC_RUN_IFELSE([AC_LANG_PROGRAM([[
// External functions from ARPACK library
extern "C" int
F77_FUNC (dnaupd, DNAUPD) (int&, const char *, const int&, const char *,
int&, const double&, double*, const int&,
double*, const int&, int*, int*, double*,
double*, const int&, int&, long int, long int);
extern "C" int
F77_FUNC (dneupd, DNEUPD) (const int&, const char *, int*, double*,
double*, double*, const int&,
const double&, const double&, double*,
const char*, const int&, const char *,
int&, const double&, double*, const int&,
double*, const int&, int*, int*, double*,
double*, const int&, int&, long int,
long int, long int);
extern "C" int
F77_FUNC (dgemv, DGEMV) (const char *, const int&, const int&,
const double&, const double*, const int&,
const double*, const int&, const double&,
double*, const int&, long int);
#include
void
doit (void)
{
// Based on the octave function EigsRealNonSymmetricMatrix from
// liboctave/eigs-base.cc.
// Problem matrix. See bug #31479
int n = 4;
double *m = new double [n * n];
m[0] = 1, m[4] = 0, m[8] = 0, m[12] = -1;
m[1] = 0, m[5] = 1, m[9] = 0, m[13] = 0;
m[2] = 0, m[6] = 0, m[10] = 1, m[14] = 0;
m[3] = 0, m[7] = 0, m[11] = 2, m[15] = 1;
double *resid = new double [4];
resid[0] = 0.960966;
resid[1] = 0.741195;
resid[2] = 0.150143;
resid[3] = 0.868067;
int *ip = new int [11];
ip[0] = 1; // ishift
ip[1] = 0; // ip[1] not referenced
ip[2] = 300; // mxiter, maximum number of iterations
ip[3] = 1; // NB blocksize in recurrence
ip[4] = 0; // nconv, number of Ritz values that satisfy convergence
ip[5] = 0; // ip[5] not referenced
ip[6] = 1; // mode
ip[7] = 0; // ip[7] to ip[10] are return values
ip[8] = 0;
ip[9] = 0;
ip[10] = 0;
int *ipntr = new int [14];
int k = 1;
int p = 3;
int lwork = 3 * p * (p + 2);
double *v = new double [n * (p + 1)];
double *workl = new double [lwork + 1];
double *workd = new double [3 * n + 1];
int ido = 0;
int info = 0;
double tol = DBL_EPSILON;
do
{
F77_FUNC (dnaupd, DNAUPD) (ido, "I", n, "LM", k, tol, resid, p,
v, n, ip, ipntr, workd, workl, lwork,
info, 1L, 2L);
if (ido == -1 || ido == 1 || ido == 2)
{
double *x = workd + ipntr[0] - 1;
double *y = workd + ipntr[1] - 1;
F77_FUNC (dgemv, DGEMV) ("N", n, n, 1.0, m, n, x, 1, 0.0,
y, 1, 1L);
}
else
{
if (info < 0)
{
return; // Error
}
break;
}
}
while (1);
int *sel = new int [p];
// In Octave, the dimensions of dr and di are k+1, but k+2 avoids segfault
double *dr = new double [k + 1];
double *di = new double [k + 1];
double *workev = new double [3 * p];
for (int i = 0; i < k + 1; i++)
dr[i] = di[i] = 0.;
int rvec = 1;
double sigmar = 0.0;
double sigmai = 0.0;
// In Octave, this is n*(k+1), but k+2 avoids segfault
double *z = new double [n * (k + 1)];
F77_FUNC (dneupd, DNEUPD) (rvec, "A", sel, dr, di, z, n, sigmar,
sigmai, workev, "I", n, "LM", k, tol,
resid, p, v, n, ip, ipntr, workd,
workl, lwork, info, 1L, 1L, 2L);
}
]], [[
for (int i = 0; i < 10; i++)
doit ();
]])],
[cv_lib_arpack_ok=yes],
[cv_lib_arpack_ok=no],
[cv_lib_arpack_ok=yes])])
AC_LANG_POP(C++)
if test "$cv_lib_arpack_ok" = "yes"; then
$1
else
$2
fi
])
arpack-ng-3.1.5/config.sub 0000755 0001750 0001750 00000105315 12277373057 012311 0000000 0000000 #! /bin/sh
# Configuration validation subroutine script.
# Copyright 1992-2013 Free Software Foundation, Inc.
timestamp='2013-04-24'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, see .
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that
# program. This Exception is an additional permission under section 7
# of the GNU General Public License, version 3 ("GPLv3").
# Please send patches with a ChangeLog entry to config-patches@gnu.org.
#
# Configuration subroutine to validate and canonicalize a configuration type.
# Supply the specified configuration type as an argument.
# If it is invalid, we print an error message on stderr and exit with code 1.
# Otherwise, we print the canonical config type on stdout and succeed.
# You can get the latest version of this script from:
# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
# This file is supposed to be the same for all GNU packages
# and recognize all the CPU types, system types and aliases
# that are meaningful with *any* GNU software.
# Each package is responsible for reporting which valid configurations
# it does not support. The user should be able to distinguish
# a failure to support a valid configuration from a meaningless
# configuration.
# The goal of this file is to map all the various variations of a given
# machine specification into a single specification in the form:
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
# or in some cases, the newer four-part form:
# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
# It is wrong to echo any other type of specification.
me=`echo "$0" | sed -e 's,.*/,,'`
usage="\
Usage: $0 [OPTION] CPU-MFR-OPSYS
$0 [OPTION] ALIAS
Canonicalize a configuration name.
Operation modes:
-h, --help print this help, then exit
-t, --time-stamp print date of last modification, then exit
-v, --version print version number, then exit
Report bugs and patches to ."
version="\
GNU config.sub ($timestamp)
Copyright 1992-2013 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
help="
Try \`$me --help' for more information."
# Parse command line
while test $# -gt 0 ; do
case $1 in
--time-stamp | --time* | -t )
echo "$timestamp" ; exit ;;
--version | -v )
echo "$version" ; exit ;;
--help | --h* | -h )
echo "$usage"; exit ;;
-- ) # Stop option processing
shift; break ;;
- ) # Use stdin as input.
break ;;
-* )
echo "$me: invalid option $1$help"
exit 1 ;;
*local*)
# First pass through any local machine types.
echo $1
exit ;;
* )
break ;;
esac
done
case $# in
0) echo "$me: missing argument$help" >&2
exit 1;;
1) ;;
*) echo "$me: too many arguments$help" >&2
exit 1;;
esac
# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
# Here we must recognize all the valid KERNEL-OS combinations.
maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
case $maybe_os in
nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \
linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \
knetbsd*-gnu* | netbsd*-gnu* | \
kopensolaris*-gnu* | \
storm-chaos* | os2-emx* | rtmk-nova*)
os=-$maybe_os
basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
;;
android-linux)
os=-linux-android
basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown
;;
*)
basic_machine=`echo $1 | sed 's/-[^-]*$//'`
if [ $basic_machine != $1 ]
then os=`echo $1 | sed 's/.*-/-/'`
else os=; fi
;;
esac
### Let's recognize common machines as not being operating systems so
### that things like config.sub decstation-3100 work. We also
### recognize some manufacturers as not being operating systems, so we
### can provide default operating systems below.
case $os in
-sun*os*)
# Prevent following clause from handling this invalid input.
;;
-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
-apple | -axis | -knuth | -cray | -microblaze*)
os=
basic_machine=$1
;;
-bluegene*)
os=-cnk
;;
-sim | -cisco | -oki | -wec | -winbond)
os=
basic_machine=$1
;;
-scout)
;;
-wrs)
os=-vxworks
basic_machine=$1
;;
-chorusos*)
os=-chorusos
basic_machine=$1
;;
-chorusrdb)
os=-chorusrdb
basic_machine=$1
;;
-hiux*)
os=-hiuxwe2
;;
-sco6)
os=-sco5v6
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco5)
os=-sco3.2v5
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco4)
os=-sco3.2v4
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco3.2.[4-9]*)
os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco3.2v[4-9]*)
# Don't forget version if it is 3.2v4 or newer.
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco5v6*)
# Don't forget version if it is 3.2v4 or newer.
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-sco*)
os=-sco3.2v2
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-udk*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-isc)
os=-isc2.2
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-clix*)
basic_machine=clipper-intergraph
;;
-isc*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
;;
-lynx*178)
os=-lynxos178
;;
-lynx*5)
os=-lynxos5
;;
-lynx*)
os=-lynxos
;;
-ptx*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
;;
-windowsnt*)
os=`echo $os | sed -e 's/windowsnt/winnt/'`
;;
-psos*)
os=-psos
;;
-mint | -mint[0-9]*)
basic_machine=m68k-atari
os=-mint
;;
esac
# Decode aliases for certain CPU-COMPANY combinations.
case $basic_machine in
# Recognize the basic CPU types without company name.
# Some are omitted here because they have special meanings below.
1750a | 580 \
| a29k \
| aarch64 | aarch64_be \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
| am33_2.0 \
| arc | arceb \
| arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \
| avr | avr32 \
| be32 | be64 \
| bfin \
| c4x | clipper \
| d10v | d30v | dlx | dsp16xx \
| epiphany \
| fido | fr30 | frv \
| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
| hexagon \
| i370 | i860 | i960 | ia64 \
| ip2k | iq2000 \
| le32 | le64 \
| lm32 \
| m32c | m32r | m32rle | m68000 | m68k | m88k \
| maxq | mb | microblaze | microblazeel | mcore | mep | metag \
| mips | mipsbe | mipseb | mipsel | mipsle \
| mips16 \
| mips64 | mips64el \
| mips64octeon | mips64octeonel \
| mips64orion | mips64orionel \
| mips64r5900 | mips64r5900el \
| mips64vr | mips64vrel \
| mips64vr4100 | mips64vr4100el \
| mips64vr4300 | mips64vr4300el \
| mips64vr5000 | mips64vr5000el \
| mips64vr5900 | mips64vr5900el \
| mipsisa32 | mipsisa32el \
| mipsisa32r2 | mipsisa32r2el \
| mipsisa64 | mipsisa64el \
| mipsisa64r2 | mipsisa64r2el \
| mipsisa64sb1 | mipsisa64sb1el \
| mipsisa64sr71k | mipsisa64sr71kel \
| mipsr5900 | mipsr5900el \
| mipstx39 | mipstx39el \
| mn10200 | mn10300 \
| moxie \
| mt \
| msp430 \
| nds32 | nds32le | nds32be \
| nios | nios2 | nios2eb | nios2el \
| ns16k | ns32k \
| open8 \
| or1k | or32 \
| pdp10 | pdp11 | pj | pjl \
| powerpc | powerpc64 | powerpc64le | powerpcle \
| pyramid \
| rl78 | rx \
| score \
| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
| sh64 | sh64le \
| sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \
| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
| spu \
| tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \
| ubicom32 \
| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
| we32k \
| x86 | xc16x | xstormy16 | xtensa \
| z8k | z80)
basic_machine=$basic_machine-unknown
;;
c54x)
basic_machine=tic54x-unknown
;;
c55x)
basic_machine=tic55x-unknown
;;
c6x)
basic_machine=tic6x-unknown
;;
m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip)
basic_machine=$basic_machine-unknown
os=-none
;;
m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
;;
ms1)
basic_machine=mt-unknown
;;
strongarm | thumb | xscale)
basic_machine=arm-unknown
;;
xgate)
basic_machine=$basic_machine-unknown
os=-none
;;
xscaleeb)
basic_machine=armeb-unknown
;;
xscaleel)
basic_machine=armel-unknown
;;
# We use `pc' rather than `unknown'
# because (1) that's what they normally are, and
# (2) the word "unknown" tends to confuse beginning users.
i*86 | x86_64)
basic_machine=$basic_machine-pc
;;
# Object if more than one company name word.
*-*-*)
echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
exit 1
;;
# Recognize the basic CPU types with company name.
580-* \
| a29k-* \
| aarch64-* | aarch64_be-* \
| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
| alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \
| arm-* | armbe-* | armle-* | armeb-* | armv*-* \
| avr-* | avr32-* \
| be32-* | be64-* \
| bfin-* | bs2000-* \
| c[123]* | c30-* | [cjt]90-* | c4x-* \
| clipper-* | craynv-* | cydra-* \
| d10v-* | d30v-* | dlx-* \
| elxsi-* \
| f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \
| h8300-* | h8500-* \
| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
| hexagon-* \
| i*86-* | i860-* | i960-* | ia64-* \
| ip2k-* | iq2000-* \
| le32-* | le64-* \
| lm32-* \
| m32c-* | m32r-* | m32rle-* \
| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
| microblaze-* | microblazeel-* \
| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
| mips16-* \
| mips64-* | mips64el-* \
| mips64octeon-* | mips64octeonel-* \
| mips64orion-* | mips64orionel-* \
| mips64r5900-* | mips64r5900el-* \
| mips64vr-* | mips64vrel-* \
| mips64vr4100-* | mips64vr4100el-* \
| mips64vr4300-* | mips64vr4300el-* \
| mips64vr5000-* | mips64vr5000el-* \
| mips64vr5900-* | mips64vr5900el-* \
| mipsisa32-* | mipsisa32el-* \
| mipsisa32r2-* | mipsisa32r2el-* \
| mipsisa64-* | mipsisa64el-* \
| mipsisa64r2-* | mipsisa64r2el-* \
| mipsisa64sb1-* | mipsisa64sb1el-* \
| mipsisa64sr71k-* | mipsisa64sr71kel-* \
| mipsr5900-* | mipsr5900el-* \
| mipstx39-* | mipstx39el-* \
| mmix-* \
| mt-* \
| msp430-* \
| nds32-* | nds32le-* | nds32be-* \
| nios-* | nios2-* | nios2eb-* | nios2el-* \
| none-* | np1-* | ns16k-* | ns32k-* \
| open8-* \
| orion-* \
| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \
| pyramid-* \
| rl78-* | romp-* | rs6000-* | rx-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
| sparclite-* \
| sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \
| tahoe-* \
| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
| tile*-* \
| tron-* \
| ubicom32-* \
| v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \
| vax-* \
| we32k-* \
| x86-* | x86_64-* | xc16x-* | xps100-* \
| xstormy16-* | xtensa*-* \
| ymp-* \
| z8k-* | z80-*)
;;
# Recognize the basic CPU types without company name, with glob match.
xtensa*)
basic_machine=$basic_machine-unknown
;;
# Recognize the various machine names and aliases which stand
# for a CPU type and a company and sometimes even an OS.
386bsd)
basic_machine=i386-unknown
os=-bsd
;;
3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
basic_machine=m68000-att
;;
3b*)
basic_machine=we32k-att
;;
a29khif)
basic_machine=a29k-amd
os=-udi
;;
abacus)
basic_machine=abacus-unknown
;;
adobe68k)
basic_machine=m68010-adobe
os=-scout
;;
alliant | fx80)
basic_machine=fx80-alliant
;;
altos | altos3068)
basic_machine=m68k-altos
;;
am29k)
basic_machine=a29k-none
os=-bsd
;;
amd64)
basic_machine=x86_64-pc
;;
amd64-*)
basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
amdahl)
basic_machine=580-amdahl
os=-sysv
;;
amiga | amiga-*)
basic_machine=m68k-unknown
;;
amigaos | amigados)
basic_machine=m68k-unknown
os=-amigaos
;;
amigaunix | amix)
basic_machine=m68k-unknown
os=-sysv4
;;
apollo68)
basic_machine=m68k-apollo
os=-sysv
;;
apollo68bsd)
basic_machine=m68k-apollo
os=-bsd
;;
aros)
basic_machine=i386-pc
os=-aros
;;
aux)
basic_machine=m68k-apple
os=-aux
;;
balance)
basic_machine=ns32k-sequent
os=-dynix
;;
blackfin)
basic_machine=bfin-unknown
os=-linux
;;
blackfin-*)
basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'`
os=-linux
;;
bluegene*)
basic_machine=powerpc-ibm
os=-cnk
;;
c54x-*)
basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
c55x-*)
basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
c6x-*)
basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
c90)
basic_machine=c90-cray
os=-unicos
;;
cegcc)
basic_machine=arm-unknown
os=-cegcc
;;
convex-c1)
basic_machine=c1-convex
os=-bsd
;;
convex-c2)
basic_machine=c2-convex
os=-bsd
;;
convex-c32)
basic_machine=c32-convex
os=-bsd
;;
convex-c34)
basic_machine=c34-convex
os=-bsd
;;
convex-c38)
basic_machine=c38-convex
os=-bsd
;;
cray | j90)
basic_machine=j90-cray
os=-unicos
;;
craynv)
basic_machine=craynv-cray
os=-unicosmp
;;
cr16 | cr16-*)
basic_machine=cr16-unknown
os=-elf
;;
crds | unos)
basic_machine=m68k-crds
;;
crisv32 | crisv32-* | etraxfs*)
basic_machine=crisv32-axis
;;
cris | cris-* | etrax*)
basic_machine=cris-axis
;;
crx)
basic_machine=crx-unknown
os=-elf
;;
da30 | da30-*)
basic_machine=m68k-da30
;;
decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
basic_machine=mips-dec
;;
decsystem10* | dec10*)
basic_machine=pdp10-dec
os=-tops10
;;
decsystem20* | dec20*)
basic_machine=pdp10-dec
os=-tops20
;;
delta | 3300 | motorola-3300 | motorola-delta \
| 3300-motorola | delta-motorola)
basic_machine=m68k-motorola
;;
delta88)
basic_machine=m88k-motorola
os=-sysv3
;;
dicos)
basic_machine=i686-pc
os=-dicos
;;
djgpp)
basic_machine=i586-pc
os=-msdosdjgpp
;;
dpx20 | dpx20-*)
basic_machine=rs6000-bull
os=-bosx
;;
dpx2* | dpx2*-bull)
basic_machine=m68k-bull
os=-sysv3
;;
ebmon29k)
basic_machine=a29k-amd
os=-ebmon
;;
elxsi)
basic_machine=elxsi-elxsi
os=-bsd
;;
encore | umax | mmax)
basic_machine=ns32k-encore
;;
es1800 | OSE68k | ose68k | ose | OSE)
basic_machine=m68k-ericsson
os=-ose
;;
fx2800)
basic_machine=i860-alliant
;;
genix)
basic_machine=ns32k-ns
;;
gmicro)
basic_machine=tron-gmicro
os=-sysv
;;
go32)
basic_machine=i386-pc
os=-go32
;;
h3050r* | hiux*)
basic_machine=hppa1.1-hitachi
os=-hiuxwe2
;;
h8300hms)
basic_machine=h8300-hitachi
os=-hms
;;
h8300xray)
basic_machine=h8300-hitachi
os=-xray
;;
h8500hms)
basic_machine=h8500-hitachi
os=-hms
;;
harris)
basic_machine=m88k-harris
os=-sysv3
;;
hp300-*)
basic_machine=m68k-hp
;;
hp300bsd)
basic_machine=m68k-hp
os=-bsd
;;
hp300hpux)
basic_machine=m68k-hp
os=-hpux
;;
hp3k9[0-9][0-9] | hp9[0-9][0-9])
basic_machine=hppa1.0-hp
;;
hp9k2[0-9][0-9] | hp9k31[0-9])
basic_machine=m68000-hp
;;
hp9k3[2-9][0-9])
basic_machine=m68k-hp
;;
hp9k6[0-9][0-9] | hp6[0-9][0-9])
basic_machine=hppa1.0-hp
;;
hp9k7[0-79][0-9] | hp7[0-79][0-9])
basic_machine=hppa1.1-hp
;;
hp9k78[0-9] | hp78[0-9])
# FIXME: really hppa2.0-hp
basic_machine=hppa1.1-hp
;;
hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
# FIXME: really hppa2.0-hp
basic_machine=hppa1.1-hp
;;
hp9k8[0-9][13679] | hp8[0-9][13679])
basic_machine=hppa1.1-hp
;;
hp9k8[0-9][0-9] | hp8[0-9][0-9])
basic_machine=hppa1.0-hp
;;
hppa-next)
os=-nextstep3
;;
hppaosf)
basic_machine=hppa1.1-hp
os=-osf
;;
hppro)
basic_machine=hppa1.1-hp
os=-proelf
;;
i370-ibm* | ibm*)
basic_machine=i370-ibm
;;
i*86v32)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv32
;;
i*86v4*)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv4
;;
i*86v)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv
;;
i*86sol2)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-solaris2
;;
i386mach)
basic_machine=i386-mach
os=-mach
;;
i386-vsta | vsta)
basic_machine=i386-unknown
os=-vsta
;;
iris | iris4d)
basic_machine=mips-sgi
case $os in
-irix*)
;;
*)
os=-irix4
;;
esac
;;
isi68 | isi)
basic_machine=m68k-isi
os=-sysv
;;
m68knommu)
basic_machine=m68k-unknown
os=-linux
;;
m68knommu-*)
basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'`
os=-linux
;;
m88k-omron*)
basic_machine=m88k-omron
;;
magnum | m3230)
basic_machine=mips-mips
os=-sysv
;;
merlin)
basic_machine=ns32k-utek
os=-sysv
;;
microblaze*)
basic_machine=microblaze-xilinx
;;
mingw64)
basic_machine=x86_64-pc
os=-mingw64
;;
mingw32)
basic_machine=i386-pc
os=-mingw32
;;
mingw32ce)
basic_machine=arm-unknown
os=-mingw32ce
;;
miniframe)
basic_machine=m68000-convergent
;;
*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
basic_machine=m68k-atari
os=-mint
;;
mips3*-*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
;;
mips3*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
;;
monitor)
basic_machine=m68k-rom68k
os=-coff
;;
morphos)
basic_machine=powerpc-unknown
os=-morphos
;;
msdos)
basic_machine=i386-pc
os=-msdos
;;
ms1-*)
basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'`
;;
msys)
basic_machine=i386-pc
os=-msys
;;
mvs)
basic_machine=i370-ibm
os=-mvs
;;
nacl)
basic_machine=le32-unknown
os=-nacl
;;
ncr3000)
basic_machine=i486-ncr
os=-sysv4
;;
netbsd386)
basic_machine=i386-unknown
os=-netbsd
;;
netwinder)
basic_machine=armv4l-rebel
os=-linux
;;
news | news700 | news800 | news900)
basic_machine=m68k-sony
os=-newsos
;;
news1000)
basic_machine=m68030-sony
os=-newsos
;;
news-3600 | risc-news)
basic_machine=mips-sony
os=-newsos
;;
necv70)
basic_machine=v70-nec
os=-sysv
;;
next | m*-next )
basic_machine=m68k-next
case $os in
-nextstep* )
;;
-ns2*)
os=-nextstep2
;;
*)
os=-nextstep3
;;
esac
;;
nh3000)
basic_machine=m68k-harris
os=-cxux
;;
nh[45]000)
basic_machine=m88k-harris
os=-cxux
;;
nindy960)
basic_machine=i960-intel
os=-nindy
;;
mon960)
basic_machine=i960-intel
os=-mon960
;;
nonstopux)
basic_machine=mips-compaq
os=-nonstopux
;;
np1)
basic_machine=np1-gould
;;
neo-tandem)
basic_machine=neo-tandem
;;
nse-tandem)
basic_machine=nse-tandem
;;
nsr-tandem)
basic_machine=nsr-tandem
;;
op50n-* | op60c-*)
basic_machine=hppa1.1-oki
os=-proelf
;;
openrisc | openrisc-*)
basic_machine=or32-unknown
;;
os400)
basic_machine=powerpc-ibm
os=-os400
;;
OSE68000 | ose68000)
basic_machine=m68000-ericsson
os=-ose
;;
os68k)
basic_machine=m68k-none
os=-os68k
;;
pa-hitachi)
basic_machine=hppa1.1-hitachi
os=-hiuxwe2
;;
paragon)
basic_machine=i860-intel
os=-osf
;;
parisc)
basic_machine=hppa-unknown
os=-linux
;;
parisc-*)
basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'`
os=-linux
;;
pbd)
basic_machine=sparc-tti
;;
pbb)
basic_machine=m68k-tti
;;
pc532 | pc532-*)
basic_machine=ns32k-pc532
;;
pc98)
basic_machine=i386-pc
;;
pc98-*)
basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentium | p5 | k5 | k6 | nexgen | viac3)
basic_machine=i586-pc
;;
pentiumpro | p6 | 6x86 | athlon | athlon_*)
basic_machine=i686-pc
;;
pentiumii | pentium2 | pentiumiii | pentium3)
basic_machine=i686-pc
;;
pentium4)
basic_machine=i786-pc
;;
pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentiumpro-* | p6-* | 6x86-* | athlon-*)
basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentium4-*)
basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pn)
basic_machine=pn-gould
;;
power) basic_machine=power-ibm
;;
ppc | ppcbe) basic_machine=powerpc-unknown
;;
ppc-* | ppcbe-*)
basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppcle | powerpclittle | ppc-le | powerpc-little)
basic_machine=powerpcle-unknown
;;
ppcle-* | powerpclittle-*)
basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppc64) basic_machine=powerpc64-unknown
;;
ppc64-* | ppc64p7-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppc64le | powerpc64little | ppc64-le | powerpc64-little)
basic_machine=powerpc64le-unknown
;;
ppc64le-* | powerpc64little-*)
basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ps2)
basic_machine=i386-ibm
;;
pw32)
basic_machine=i586-unknown
os=-pw32
;;
rdos | rdos64)
basic_machine=x86_64-pc
os=-rdos
;;
rdos32)
basic_machine=i386-pc
os=-rdos
;;
rom68k)
basic_machine=m68k-rom68k
os=-coff
;;
rm[46]00)
basic_machine=mips-siemens
;;
rtpc | rtpc-*)
basic_machine=romp-ibm
;;
s390 | s390-*)
basic_machine=s390-ibm
;;
s390x | s390x-*)
basic_machine=s390x-ibm
;;
sa29200)
basic_machine=a29k-amd
os=-udi
;;
sb1)
basic_machine=mipsisa64sb1-unknown
;;
sb1el)
basic_machine=mipsisa64sb1el-unknown
;;
sde)
basic_machine=mipsisa32-sde
os=-elf
;;
sei)
basic_machine=mips-sei
os=-seiux
;;
sequent)
basic_machine=i386-sequent
;;
sh)
basic_machine=sh-hitachi
os=-hms
;;
sh5el)
basic_machine=sh5le-unknown
;;
sh64)
basic_machine=sh64-unknown
;;
sparclite-wrs | simso-wrs)
basic_machine=sparclite-wrs
os=-vxworks
;;
sps7)
basic_machine=m68k-bull
os=-sysv2
;;
spur)
basic_machine=spur-unknown
;;
st2000)
basic_machine=m68k-tandem
;;
stratus)
basic_machine=i860-stratus
os=-sysv4
;;
strongarm-* | thumb-*)
basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
sun2)
basic_machine=m68000-sun
;;
sun2os3)
basic_machine=m68000-sun
os=-sunos3
;;
sun2os4)
basic_machine=m68000-sun
os=-sunos4
;;
sun3os3)
basic_machine=m68k-sun
os=-sunos3
;;
sun3os4)
basic_machine=m68k-sun
os=-sunos4
;;
sun4os3)
basic_machine=sparc-sun
os=-sunos3
;;
sun4os4)
basic_machine=sparc-sun
os=-sunos4
;;
sun4sol2)
basic_machine=sparc-sun
os=-solaris2
;;
sun3 | sun3-*)
basic_machine=m68k-sun
;;
sun4)
basic_machine=sparc-sun
;;
sun386 | sun386i | roadrunner)
basic_machine=i386-sun
;;
sv1)
basic_machine=sv1-cray
os=-unicos
;;
symmetry)
basic_machine=i386-sequent
os=-dynix
;;
t3e)
basic_machine=alphaev5-cray
os=-unicos
;;
t90)
basic_machine=t90-cray
os=-unicos
;;
tile*)
basic_machine=$basic_machine-unknown
os=-linux-gnu
;;
tx39)
basic_machine=mipstx39-unknown
;;
tx39el)
basic_machine=mipstx39el-unknown
;;
toad1)
basic_machine=pdp10-xkl
os=-tops20
;;
tower | tower-32)
basic_machine=m68k-ncr
;;
tpf)
basic_machine=s390x-ibm
os=-tpf
;;
udi29k)
basic_machine=a29k-amd
os=-udi
;;
ultra3)
basic_machine=a29k-nyu
os=-sym1
;;
v810 | necv810)
basic_machine=v810-nec
os=-none
;;
vaxv)
basic_machine=vax-dec
os=-sysv
;;
vms)
basic_machine=vax-dec
os=-vms
;;
vpp*|vx|vx-*)
basic_machine=f301-fujitsu
;;
vxworks960)
basic_machine=i960-wrs
os=-vxworks
;;
vxworks68)
basic_machine=m68k-wrs
os=-vxworks
;;
vxworks29k)
basic_machine=a29k-wrs
os=-vxworks
;;
w65*)
basic_machine=w65-wdc
os=-none
;;
w89k-*)
basic_machine=hppa1.1-winbond
os=-proelf
;;
xbox)
basic_machine=i686-pc
os=-mingw32
;;
xps | xps100)
basic_machine=xps100-honeywell
;;
xscale-* | xscalee[bl]-*)
basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'`
;;
ymp)
basic_machine=ymp-cray
os=-unicos
;;
z8k-*-coff)
basic_machine=z8k-unknown
os=-sim
;;
z80-*-coff)
basic_machine=z80-unknown
os=-sim
;;
none)
basic_machine=none-none
os=-none
;;
# Here we handle the default manufacturer of certain CPU types. It is in
# some cases the only manufacturer, in others, it is the most popular.
w89k)
basic_machine=hppa1.1-winbond
;;
op50n)
basic_machine=hppa1.1-oki
;;
op60c)
basic_machine=hppa1.1-oki
;;
romp)
basic_machine=romp-ibm
;;
mmix)
basic_machine=mmix-knuth
;;
rs6000)
basic_machine=rs6000-ibm
;;
vax)
basic_machine=vax-dec
;;
pdp10)
# there are many clones, so DEC is not a safe bet
basic_machine=pdp10-unknown
;;
pdp11)
basic_machine=pdp11-dec
;;
we32k)
basic_machine=we32k-att
;;
sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele)
basic_machine=sh-unknown
;;
sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v)
basic_machine=sparc-sun
;;
cydra)
basic_machine=cydra-cydrome
;;
orion)
basic_machine=orion-highlevel
;;
orion105)
basic_machine=clipper-highlevel
;;
mac | mpw | mac-mpw)
basic_machine=m68k-apple
;;
pmac | pmac-mpw)
basic_machine=powerpc-apple
;;
*-unknown)
# Make sure to match an already-canonicalized machine name.
;;
*)
echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
exit 1
;;
esac
# Here we canonicalize certain aliases for manufacturers.
case $basic_machine in
*-digital*)
basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
;;
*-commodore*)
basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
;;
*)
;;
esac
# Decode manufacturer-specific aliases for certain operating systems.
if [ x"$os" != x"" ]
then
case $os in
# First match some system type aliases
# that might get confused with valid system types.
# -solaris* is a basic system type, with this one exception.
-auroraux)
os=-auroraux
;;
-solaris1 | -solaris1.*)
os=`echo $os | sed -e 's|solaris1|sunos4|'`
;;
-solaris)
os=-solaris2
;;
-svr4*)
os=-sysv4
;;
-unixware*)
os=-sysv4.2uw
;;
-gnu/linux*)
os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
;;
# First accept the basic system types.
# The portable systems comes first.
# Each alternative MUST END IN A *, to match a version number.
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
| -sym* | -kopensolaris* | -plan9* \
| -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
| -aos* | -aros* \
| -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
| -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
| -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \
| -bitrig* | -openbsd* | -solidbsd* \
| -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
| -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
| -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
| -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
| -chorusos* | -chorusrdb* | -cegcc* \
| -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
| -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \
| -linux-newlib* | -linux-musl* | -linux-uclibc* \
| -uxpv* | -beos* | -mpeix* | -udk* \
| -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
| -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
| -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
| -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
| -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
| -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
| -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*)
# Remember, each alternative MUST END IN *, to match a version number.
;;
-qnx*)
case $basic_machine in
x86-* | i*86-*)
;;
*)
os=-nto$os
;;
esac
;;
-nto-qnx*)
;;
-nto*)
os=`echo $os | sed -e 's|nto|nto-qnx|'`
;;
-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
| -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
| -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
;;
-mac*)
os=`echo $os | sed -e 's|mac|macos|'`
;;
-linux-dietlibc)
os=-linux-dietlibc
;;
-linux*)
os=`echo $os | sed -e 's|linux|linux-gnu|'`
;;
-sunos5*)
os=`echo $os | sed -e 's|sunos5|solaris2|'`
;;
-sunos6*)
os=`echo $os | sed -e 's|sunos6|solaris3|'`
;;
-opened*)
os=-openedition
;;
-os400*)
os=-os400
;;
-wince*)
os=-wince
;;
-osfrose*)
os=-osfrose
;;
-osf*)
os=-osf
;;
-utek*)
os=-bsd
;;
-dynix*)
os=-bsd
;;
-acis*)
os=-aos
;;
-atheos*)
os=-atheos
;;
-syllable*)
os=-syllable
;;
-386bsd)
os=-bsd
;;
-ctix* | -uts*)
os=-sysv
;;
-nova*)
os=-rtmk-nova
;;
-ns2 )
os=-nextstep2
;;
-nsk*)
os=-nsk
;;
# Preserve the version number of sinix5.
-sinix5.*)
os=`echo $os | sed -e 's|sinix|sysv|'`
;;
-sinix*)
os=-sysv4
;;
-tpf*)
os=-tpf
;;
-triton*)
os=-sysv3
;;
-oss*)
os=-sysv3
;;
-svr4)
os=-sysv4
;;
-svr3)
os=-sysv3
;;
-sysvr4)
os=-sysv4
;;
# This must come after -sysvr4.
-sysv*)
;;
-ose*)
os=-ose
;;
-es1800*)
os=-ose
;;
-xenix)
os=-xenix
;;
-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
os=-mint
;;
-aros*)
os=-aros
;;
-zvmoe)
os=-zvmoe
;;
-dicos*)
os=-dicos
;;
-nacl*)
;;
-none)
;;
*)
# Get rid of the `-' at the beginning of $os.
os=`echo $os | sed 's/[^-]*-//'`
echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
exit 1
;;
esac
else
# Here we handle the default operating systems that come with various machines.
# The value should be what the vendor currently ships out the door with their
# machine or put another way, the most popular os provided with the machine.
# Note that if you're going to try to match "-MANUFACTURER" here (say,
# "-sun"), then you have to tell the case statement up towards the top
# that MANUFACTURER isn't an operating system. Otherwise, code above
# will signal an error saying that MANUFACTURER isn't an operating
# system, and we'll never get to this point.
case $basic_machine in
score-*)
os=-elf
;;
spu-*)
os=-elf
;;
*-acorn)
os=-riscix1.2
;;
arm*-rebel)
os=-linux
;;
arm*-semi)
os=-aout
;;
c4x-* | tic4x-*)
os=-coff
;;
hexagon-*)
os=-elf
;;
tic54x-*)
os=-coff
;;
tic55x-*)
os=-coff
;;
tic6x-*)
os=-coff
;;
# This must come before the *-dec entry.
pdp10-*)
os=-tops20
;;
pdp11-*)
os=-none
;;
*-dec | vax-*)
os=-ultrix4.2
;;
m68*-apollo)
os=-domain
;;
i386-sun)
os=-sunos4.0.2
;;
m68000-sun)
os=-sunos3
;;
m68*-cisco)
os=-aout
;;
mep-*)
os=-elf
;;
mips*-cisco)
os=-elf
;;
mips*-*)
os=-elf
;;
or1k-*)
os=-elf
;;
or32-*)
os=-coff
;;
*-tti) # must be before sparc entry or we get the wrong os.
os=-sysv3
;;
sparc-* | *-sun)
os=-sunos4.1.1
;;
*-be)
os=-beos
;;
*-haiku)
os=-haiku
;;
*-ibm)
os=-aix
;;
*-knuth)
os=-mmixware
;;
*-wec)
os=-proelf
;;
*-winbond)
os=-proelf
;;
*-oki)
os=-proelf
;;
*-hp)
os=-hpux
;;
*-hitachi)
os=-hiux
;;
i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
os=-sysv
;;
*-cbm)
os=-amigaos
;;
*-dg)
os=-dgux
;;
*-dolphin)
os=-sysv3
;;
m68k-ccur)
os=-rtu
;;
m88k-omron*)
os=-luna
;;
*-next )
os=-nextstep
;;
*-sequent)
os=-ptx
;;
*-crds)
os=-unos
;;
*-ns)
os=-genix
;;
i370-*)
os=-mvs
;;
*-next)
os=-nextstep3
;;
*-gould)
os=-sysv
;;
*-highlevel)
os=-bsd
;;
*-encore)
os=-bsd
;;
*-sgi)
os=-irix
;;
*-siemens)
os=-sysv4
;;
*-masscomp)
os=-rtu
;;
f30[01]-fujitsu | f700-fujitsu)
os=-uxpv
;;
*-rom68k)
os=-coff
;;
*-*bug)
os=-coff
;;
*-apple)
os=-macos
;;
*-atari*)
os=-mint
;;
*)
os=-none
;;
esac
fi
# Here we handle the case where we know the os, and the CPU type, but not the
# manufacturer. We pick the logical manufacturer.
vendor=unknown
case $basic_machine in
*-unknown)
case $os in
-riscix*)
vendor=acorn
;;
-sunos*)
vendor=sun
;;
-cnk*|-aix*)
vendor=ibm
;;
-beos*)
vendor=be
;;
-hpux*)
vendor=hp
;;
-mpeix*)
vendor=hp
;;
-hiux*)
vendor=hitachi
;;
-unos*)
vendor=crds
;;
-dgux*)
vendor=dg
;;
-luna*)
vendor=omron
;;
-genix*)
vendor=ns
;;
-mvs* | -opened*)
vendor=ibm
;;
-os400*)
vendor=ibm
;;
-ptx*)
vendor=sequent
;;
-tpf*)
vendor=ibm
;;
-vxsim* | -vxworks* | -windiss*)
vendor=wrs
;;
-aux*)
vendor=apple
;;
-hms*)
vendor=hitachi
;;
-mpw* | -macos*)
vendor=apple
;;
-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
vendor=atari
;;
-vos*)
vendor=stratus
;;
esac
basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
;;
esac
echo $basic_machine$os
exit
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
# End:
arpack-ng-3.1.5/README 0000644 0001750 0001750 00000006706 12277373057 011212 0000000 0000000 ARPACK-NG is a collection of Fortran77 subroutines designed to solve large scale
eigenvalue problems.
Important Features:
* Reverse Communication Interface.
* Single and Double Precision Real Arithmetic Versions for Symmetric,
Non-symmetric, Standard or Generalized Problems.
* Single and Double Precision Complex Arithmetic Versions for Standard or
Generalized Problems.
* Routines for Banded Matrices - Standard or Generalized Problems.
* Routines for The Singular Value Decomposition.
* Example driver routines that may be used as templates to implement numerous
Shift-Invert strategies for all problem types, data types and precision.
This project is a joint project between Debian, Octave and Scilab in order to
provide a common and maintained version of arpack.
Indeed, no single release has been published by Rice university for the last
few years and since many software (Octave, Scilab, R, Matlab...) forked it and
implemented their own modifications, arpack-ng aims to tackle this by providing
a common repository and maintained versions.
arpack-ng is replacing arpack in Debian & Ubuntu. Fink, Fedora and Redhat are
currently doing the same move.
1. You have successfully unbundled ARPACK-NG and are now in the ARPACK-NG
directory that was created for you.
2.
The directory SRC contains the top level routines including
the highest level reverse communication interface routines
ssaupd, dsaupd - symmetric single and double precision
snaupd, dnaupd - non-symmetric single and double precision
cnaupd, znaupd - complex non-symmetric single and double precision
The headers of these routines contain full documentation of calling
sequence and usage. Additional information is in the DOCUMENTS directory.
The directory PARPACK contains the Parallel ARPACK routines.
3. 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' command you should see
BAND
COMPLEX
NONSYM
README
SIMPLE
SVD
SYM
Example programs for banded, complex, nonsymmetric, symmetric,
and singular value decomposition may be found in the directories
BAND, COMPLEX, NONSYM, SYM, SVD respectively. Look at the README
file for further information. To get started, get into the SIMPLE
directory to see example programs that illustrate the use of ARPACK in
the simplest modes of operation for the most commonly posed
standard eigenvalue problems.
Example programs for Parallel ARPACK may be found in the directory
PARPACK/EXAMPLES. Look at the README file for further information.
The following instructions explain how to make the ARPACK library.
4. Unlike ARPACK, ARPACK-NG is providing autotools based build system.
Therefor, the classical:
$ ./configure
$ make
$ make install
should work as expected.
5. Within DOCUMENTS directory there are three files
ex-sym.doc
ex-nonsym.doc and
ex-complex.doc
for templates on how to invoke the computational modes of ARPACK.
Also look in the README file for explanations concerning the
other documents.
Danny Sorensen at sorensen@caam.rice.edu
Richard Lehoucq at rblehou@sandia.gov
Chao Yang at cyang@lbl.gov
Kristi Maschhoff at kristyn@tera.com
Sylvestre Ledru at sylvestre.ledru@scilab-enterprises.com
Allan Cornet at allan.cornet@scilab.org
Good luck and enjoy.
arpack-ng-3.1.5/Makefile.am 0000644 0001750 0001750 00000001340 12277666307 012356 0000000 0000000 SUBDIRS = UTIL SRC . TESTS EXAMPLES
if MPI
SUBDIRS += PARPACK
endif
lib_LTLIBRARIES = libarpack.la
ACLOCAL_AMFLAGS = -I m4/
libarpack_la_SOURCES =
# Force libarpack to be linked with the Fortran compiler.
# The file dummy.f does not need to exist in the source tree.
nodist_EXTRA_libarpack_la_SOURCES = dummy.f
libarpack_la_LDFLAGS = -no-undefined -version-info 2:0
libarpack_la_LIBADD = \
$(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la \
$(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = README PARPACK_CHANGES CHANGES DOCUMENTS EXAMPLES VISUAL_STUDIO \
detect_arpack_bug.m4
# Pkgconfig directory
pkgconfigdir = $(libdir)/pkgconfig
# Files to install in Pkgconfig directory
pkgconfig_DATA = arpack.pc
arpack-ng-3.1.5/configure.ac 0000644 0001750 0001750 00000003215 12277666454 012616 0000000 0000000 AC_PREREQ(2.59)
AC_INIT([arpack-ng], [3.1.5], [http://forge.scilab.org/index.php/p/arpack-ng/issues/])
AM_INIT_AUTOMAKE([foreign])
AM_MAINTAINER_MODE
AC_CONFIG_MACRO_DIR([m4/])
dnl Checks for standard programs.
AC_PROG_F77
ifdef([LT_INIT], [], [
errprint([error: you must have libtool 2.4.2 or a more recent version
])
m4exit([1])])
LT_PREREQ([2.4.2])
LT_INIT([win32-dll])
dnl Check for BLAS libraries
sinclude(ax_blas.m4)
AX_BLAS
if test "$ax_blas_ok" = "no"; then
AC_MSG_ERROR([Cannot find BLAS libraries])
fi
dnl Check for LAPACK libraries
sinclude(ax_lapack.m4)
AX_LAPACK
if test "$ax_lapack_ok" = "no"; then
AC_MSG_ERROR([Cannot find LAPACK libraries])
fi
dnl See if compiling parpack
AC_MSG_CHECKING([for MPI mode])
AC_ARG_ENABLE(mpi,
AC_HELP_STRING([--enable-mpi],
[build parallel version of arpack with MPI]),
[enable_mpi=$enableval],
[enable_mpi=no])
if test x"$enable_mpi" != x"no"; then
AC_LANG_PUSH([Fortran 77])
AX_MPI([], AC_MSG_ERROR([could not compile a MPI test program]))
AC_LANG_POP([Fortran 77])
fi
AM_CONDITIONAL(MPI, test x"$enable_mpi" = x"yes")
# LAPACK/Makefile
AC_CONFIG_FILES([
arpack.pc
Makefile
SRC/Makefile
UTIL/Makefile
TESTS/Makefile
EXAMPLES/Makefile
EXAMPLES/BAND/Makefile
EXAMPLES/COMPLEX/Makefile
EXAMPLES/NONSYM/Makefile
EXAMPLES/SIMPLE/Makefile
EXAMPLES/SVD/Makefile
EXAMPLES/SYM/Makefile
PARPACK/Makefile
PARPACK/SRC/Makefile
PARPACK/SRC/MPI/Makefile
PARPACK/UTIL/Makefile
PARPACK/UTIL/MPI/Makefile
PARPACK/UTIL/BLACS/Makefile
PARPACK/EXAMPLES/MPI/Makefile
PARPACK/EXAMPLES/BLACS/Makefile
PARPACK/SRC/BLACS/Makefile
])
AC_OUTPUT
arpack-ng-3.1.5/PARPACK_CHANGES 0000644 0001750 0001750 00000026655 12277373057 012473 0000000 0000000 This file describes list of changes done by Chao Yang on parpack.
This fixes many issues in parpack libs.
Theses changes were released under the "ppatch.tar.gz" filename.
---------------------------------------------------------------------
1. 01/27/97:
[s,d]sapps.f: Loop 50 (line 375) has an incorrect upper bound:
replace
do 50 j = 1, min( j+jj, kplusp )
^^^
with
do 50 j = 1, min( i+jj, kplusp )
^^^
[s,d]napps.f: Loop 70 (line 433) has an incorrect upper bound:
replace
do 70 j = 1, min( j+jj, kplusp )
^^^
with
do 70 j = 1, min( i+jj, kplusp )
^^^
[c,z]napps.f: Loop 70 (line 365) has an incorrect upper bound:
replace
do 70 j = 1, min( j+jj, kplusp )
^^^
with
do 70 j = 1, min( i+jj, kplusp )
^^^
Without the change the code will not compile on NEC.
The parallel version of these routine needs to be modified
as well.
2. 03/28/97:
In [s,d]ndrv4.f [s,d]ndrv5.f [s,d]ndrv6.f, the array SELECT
is delecared as
select(maxnev)
It should be changed to
select(maxncv)
3. 03/28/97:
There are two empty files [s,d]naupe.f in the SRC directory.
They are not part of the ARPACK. The user should ignore
them.
4. 03/28/97:
In [s,d]seupd.f, select(ncv) is declared before ncv is declared.
Should move the declaration of select(ncv) after
c %-----------------%
c | Array Arguments |
c %-----------------%
5. 03/28/97:
all banded drivers in EXAMPLES/BAND directory have not been
checked in. Although these are the current version, the SCCS
infomartion do not show the correct version number and dates.
6. 03/28/97:
In [s,d]naupd.f the following check:
else if (mode .lt. 1 .or. mode .gt. 5) then
^^
ierr = -10
should be changed to
else if (mode .lt. 1 .or. mode .gt. 4) then
^^
ierr = -10
In [c,z]naupd.f the following check:
else if (mode .lt. 1 .or. mode .gt. 5) then
^^
ierr = -10
should be changed to
else if (mode .lt. 1 .or. mode .gt. 3) then
^^
ierr = -10
7. 04/02/97:
The mass matrix in the drivers
[s,d]ndrv4.f (NONSYM)
[s,d]nbdr4.f (BAND)
[c,z]ndrv4.f (COMPLEX)
[c,z]nbdr4.f (BAND)
needs to be scaled by 1/6 to match the piecewise
linear finite element discretization of the 1-d
convection-diffusion operator as explained in the
documentation.
8. 04/03/97:
The documentation for the SELECT array in [s,d]seupd.f should
say:
c SELECT Logical array of dimension NCV. (INPUT/WORKSPACE)
^^^^ ^^^^^^^^^^
9. 06/04/98:
p[s,d,c,z]larnv.f The integer arguement IDIST is not declared.
10. 06/04/98:
In p[s,d]neupd.f, the declaration of p[s,d]norm2 is missing.
The declaration of [s,d]nrm2 is not necessary since it is not
used.
11. 08/03/98:
In [c,z]nband.f, the documentation:
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 V, LDV, IPARAM, WORKD, WORKL, LWORKL, RWORK, IWORK, INFO )
should read
c call znband
c ( RVEC, HOWMNY, SELECT, D , Z, LDZ, SIGMA, WORKEV, N, AB,
c MB, LDA, FAC, KL, KU, WHICH, BMAT, NEV, TOL, RESID, NCV,
^^^^
c V, LDV, IPARAM, WORKD, WORKL, LWORKL, RWORK, IWORK, INFO )
12. 03/18/99
_getv0.f failed to generate a starting vector after 2 steps of classical
Gram Schmidt correction step. Fixed by increasing the maximum Gram-Schmidt
correction steps to 5.
13. 04/16/99
A print statement (*mout) in p*neupd.f went over the 72nd column.
14. 04/17/99
Modified p*larnv.f and p*getv0.f in PARPACK to fix a bug in
generating a random starting vector in parallel. Now each processor
generates its portion of the starting vector using a different seed.
15. 11/05/99
The do 10 loop in [c,z]neupd.f and p[c,z]neupd.f had incorrect index
to workl(irz). Since the loop count j starts from 0, the reference to
workl(irz) should be expressed by workl(irz+j) instead of workl(irz+j-1).
16. 06/01/2000
Variables 'rnorm' and 'eps23' are missing from the save statement list
in all __naup2 routines (both serial and parallel).
17. 07/20/2000 (all eupd, both serial and parallel)
Changed the code segment used to determine whether
reordering is necessary to move the desired and converged
Ritz values into the leading portion of the Schur form.
The previous versions used the technique to mark Ritz values that
must be put in the leading portion of the Schur form:
1. Determine which eigenvalues returned by dense eigenvalue
calculation routine are desired. This is done in two steps:
a) find a threshold value from the sorted Ritz value array
b) compare all eigenvalues returned directly from dense eigenvalue
calculation routine against this threshold value.
2. For each desired Ritz value, check the Ritz estimate.
Mark the j-th element of the select array if the j-th eigenvalue
satisfies the convergence criteria.
18. 08/08/2000
In _saitr.f and _naitr.f, add a check for NP = 0 at the very begining of
this routine
19. 09/21/2000
In [c,z]neupd.f, the IF statement:
if (numcnv .lt. nev .and.
^^^
& slapy2( m_real(workl(ibd+jj-1)),
& aimag(workl(ibd+jj-1)) )
& .le. tol*rtemp) then
is changed to
if (numcnv .lt. nconv .and.
^^^^^
& slapy2( m_real(workl(ibd+jj-1)),
& aimag(workl(ibd+jj-1)) )
& .le. tol*rtemp) then
NEV is the number of eigenvalues requested;
NCONV is the number of converged eigenvalues;
NUMCNV counts the number of converged eigenvalues;
The original IF statement will cause NUMCNV to be
inconsistent with NCONV, when fewer than NEV wanted
eigenvalues have converged but there are many converged
but unwanted Ritz values.
20. In [s,d][s,n]eupd.f, the IF statement
if (numcnv .lt. nev .and.
^^^
& workl(ibd+jj-1) .le. tol*temp1) then
is changed to
if (numcnv .lt. nconv .and.
^^^^^
& workl(ibd+jj-1) .le. tol*temp1) then
NEV is the number of eigenvalues requested;
NCONV is the number of converged eigenvalues;
NUMCNV counts the number of converged eigenvalues;
The original IF statement will cause NUMCNV to be
inconsistent with NCONV, when fewer than NEV wanted
eigenvalues have converged but there are many converged
but unwanted Ritz values.
21. 10/16/2000
Line 238 of [s,d]naup2.f went past the 72nd column. This
was caused by the extra space inserted by new Solaris cpp
when ARPACK single and double precision source codes are generate
from the naup2.F code. This line is fixed by wrapping it around
the next line.
22. 10/20/2000
Updated SCCS information for drivers in BAND, SIMPLE.
Fixed miscellaneous minor problems caused by cpp.
23. 04/10/2001
Problems reported in items 19 & 20 above exist in the
parallel codes also. The same changes have been made
in p[s,d,c,n][s,n]eupd.f
24. 04/10/2001 (reported by David Day, SNL)
There was a mistake in the orthogonalization step in
the MPI version of p[c,z]getv0.f. The original code had
call zgemv ('N', n, j-1, -one, v, ldv, workd(n+1), 1,
^^^^^^^^^^
& one, resid, 1)
It has been changed to
call zgemv ('N', n, j-1, -one, v, ldv, workl, 1, one, resid, 1)
^^^^^
Also, p[c,z]vout() was used to print out `rnorm', which
is potential problematic. The following code has been
added to correct that.
cnorm2 = cmplx(rnorm,rzero)
call pcvout (comm, logfil, 1, cnorm2, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
25. 04/10/2001
In all _aupd.f codes, iparam(2) and/or iparam(4) are used to
define NB or LEVEC. Since NB=1 is the only block size and since
LEVEC is no longer used, the statements
levec = iparam(2)
nb = iparam(4)
have been commented out. NB=1 has been added to avoid potential
confusion.
26. 04/10/2001
In all _seupd codes (both serial and parallel) the call to
_sgets had an extra arguement:
call dsgets (ishift, which , nev ,
& np , workl(irz) , workl(bounds),
& workl , workl(np+1))
^^^^^^^^^^^
they have been changed to
call dsgets (ishift, which , nev ,
& np , workl(irz) , workl(bounds),
& workl)
27. 07/21/2002
In pzneupd.f, loop 11, the intrinsic precision conversion
function 'real' should be changed to 'dble'
28. 07/21/2002
modified the comments in [c,z]neupd regarding the size of
NCV. NCV is only required to be at least NEV+1 (instead of
NEV+2) in the complex version. Changed the error testing
from
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
to
else if (ncv .le. nev .or. ncv .gt. n) then
ierr = -3
29. 07/21/2002
modified the comment in [c,z]naupd regarding the size of
NCV. NCV is only required to be at least NEV+1 (instead of
NEV+2) in the complex version.
30. 07/21/2002
In [s,d]sbdr2.f, lworkl is incorrectly set to ncv*ncv+6*ncv.
Changed it to ncv*ncv+8*ncv.
31. 10/24/2003
There was a typo in p[c,z]neupd. The call to '[c,z]ngets' is
replaced by a call to 'p[c,z]ngets' instead.
32. 10/24/2003 fixing lines that go beyond the 72nd column in p[c,z]naup2.f.
33. 10/24/2003 replace 'slamch' with 'pslamch' in p[c,z]napps.f
34. 10/24/2003 removed an extra arguement to the p[s,d]sgets() call.
35. 10/24/2003 p[c,z]naup2.f contain some lines that were incorrectly
generated by cpp. These lines have been removed in the new patch.
arpack-ng-3.1.5/compile 0000755 0001750 0001750 00000016245 12277373057 011707 0000000 0000000 #! /bin/sh
# Wrapper for compilers which do not understand '-c -o'.
scriptversion=2012-10-14.11; # UTC
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
# Written by Tom Tromey .
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# This file is maintained in Automake, please report
# bugs to or send patches to
# .
nl='
'
# We need space, tab and new line, in precisely that order. Quoting is
# there to prevent tools from complaining about whitespace usage.
IFS=" "" $nl"
file_conv=
# func_file_conv build_file lazy
# Convert a $build file to $host form and store it in $file
# Currently only supports Windows hosts. If the determined conversion
# type is listed in (the comma separated) LAZY, no conversion will
# take place.
func_file_conv ()
{
file=$1
case $file in
/ | /[!/]*) # absolute file, and not a UNC file
if test -z "$file_conv"; then
# lazily determine how to convert abs files
case `uname -s` in
MINGW*)
file_conv=mingw
;;
CYGWIN*)
file_conv=cygwin
;;
*)
file_conv=wine
;;
esac
fi
case $file_conv/,$2, in
*,$file_conv,*)
;;
mingw/*)
file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'`
;;
cygwin/*)
file=`cygpath -m "$file" || echo "$file"`
;;
wine/*)
file=`winepath -w "$file" || echo "$file"`
;;
esac
;;
esac
}
# func_cl_dashL linkdir
# Make cl look for libraries in LINKDIR
func_cl_dashL ()
{
func_file_conv "$1"
if test -z "$lib_path"; then
lib_path=$file
else
lib_path="$lib_path;$file"
fi
linker_opts="$linker_opts -LIBPATH:$file"
}
# func_cl_dashl library
# Do a library search-path lookup for cl
func_cl_dashl ()
{
lib=$1
found=no
save_IFS=$IFS
IFS=';'
for dir in $lib_path $LIB
do
IFS=$save_IFS
if $shared && test -f "$dir/$lib.dll.lib"; then
found=yes
lib=$dir/$lib.dll.lib
break
fi
if test -f "$dir/$lib.lib"; then
found=yes
lib=$dir/$lib.lib
break
fi
if test -f "$dir/lib$lib.a"; then
found=yes
lib=$dir/lib$lib.a
break
fi
done
IFS=$save_IFS
if test "$found" != yes; then
lib=$lib.lib
fi
}
# func_cl_wrapper cl arg...
# Adjust compile command to suit cl
func_cl_wrapper ()
{
# Assume a capable shell
lib_path=
shared=:
linker_opts=
for arg
do
if test -n "$eat"; then
eat=
else
case $1 in
-o)
# configure might choose to run compile as 'compile cc -o foo foo.c'.
eat=1
case $2 in
*.o | *.[oO][bB][jJ])
func_file_conv "$2"
set x "$@" -Fo"$file"
shift
;;
*)
func_file_conv "$2"
set x "$@" -Fe"$file"
shift
;;
esac
;;
-I)
eat=1
func_file_conv "$2" mingw
set x "$@" -I"$file"
shift
;;
-I*)
func_file_conv "${1#-I}" mingw
set x "$@" -I"$file"
shift
;;
-l)
eat=1
func_cl_dashl "$2"
set x "$@" "$lib"
shift
;;
-l*)
func_cl_dashl "${1#-l}"
set x "$@" "$lib"
shift
;;
-L)
eat=1
func_cl_dashL "$2"
;;
-L*)
func_cl_dashL "${1#-L}"
;;
-static)
shared=false
;;
-Wl,*)
arg=${1#-Wl,}
save_ifs="$IFS"; IFS=','
for flag in $arg; do
IFS="$save_ifs"
linker_opts="$linker_opts $flag"
done
IFS="$save_ifs"
;;
-Xlinker)
eat=1
linker_opts="$linker_opts $2"
;;
-*)
set x "$@" "$1"
shift
;;
*.cc | *.CC | *.cxx | *.CXX | *.[cC]++)
func_file_conv "$1"
set x "$@" -Tp"$file"
shift
;;
*.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO])
func_file_conv "$1" mingw
set x "$@" "$file"
shift
;;
*)
set x "$@" "$1"
shift
;;
esac
fi
shift
done
if test -n "$linker_opts"; then
linker_opts="-link$linker_opts"
fi
exec "$@" $linker_opts
exit 1
}
eat=
case $1 in
'')
echo "$0: No command. Try '$0 --help' for more information." 1>&2
exit 1;
;;
-h | --h*)
cat <<\EOF
Usage: compile [--help] [--version] PROGRAM [ARGS]
Wrapper for compilers which do not understand '-c -o'.
Remove '-o dest.o' from ARGS, run PROGRAM with the remaining
arguments, and rename the output as expected.
If you are trying to build a whole package this is not the
right script to run: please start by reading the file 'INSTALL'.
Report bugs to .
EOF
exit $?
;;
-v | --v*)
echo "compile $scriptversion"
exit $?
;;
cl | *[/\\]cl | cl.exe | *[/\\]cl.exe )
func_cl_wrapper "$@" # Doesn't return...
;;
esac
ofile=
cfile=
for arg
do
if test -n "$eat"; then
eat=
else
case $1 in
-o)
# configure might choose to run compile as 'compile cc -o foo foo.c'.
# So we strip '-o arg' only if arg is an object.
eat=1
case $2 in
*.o | *.obj)
ofile=$2
;;
*)
set x "$@" -o "$2"
shift
;;
esac
;;
*.c)
cfile=$1
set x "$@" "$1"
shift
;;
*)
set x "$@" "$1"
shift
;;
esac
fi
shift
done
if test -z "$ofile" || test -z "$cfile"; then
# If no '-o' option was seen then we might have been invoked from a
# pattern rule where we don't need one. That is ok -- this is a
# normal compilation that the losing compiler can handle. If no
# '.c' file was seen then we are probably linking. That is also
# ok.
exec "$@"
fi
# Name of file we expect compiler to create.
cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'`
# Create the lock directory.
# Note: use '[/\\:.-]' here to ensure that we don't use the same name
# that we are using for the .o file. Also, base the name on the expected
# object file name, since that is what matters with a parallel build.
lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d
while true; do
if mkdir "$lockdir" >/dev/null 2>&1; then
break
fi
sleep 1
done
# FIXME: race condition here if user kills between mkdir and trap.
trap "rmdir '$lockdir'; exit 1" 1 2 15
# Run the compile.
"$@"
ret=$?
if test -f "$cofile"; then
test "$cofile" = "$ofile" || mv "$cofile" "$ofile"
elif test -f "${cofile}bj"; then
test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile"
fi
rmdir "$lockdir"
exit $ret
# Local Variables:
# mode: shell-script
# sh-indentation: 2
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
arpack-ng-3.1.5/install-sh 0000755 0001750 0001750 00000033255 12277373057 012335 0000000 0000000 #!/bin/sh
# install - install a program, script, or datafile
scriptversion=2011-11-20.07; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
# following copyright and license.
#
# Copyright (C) 1994 X Consortium
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN
# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC-
# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name of the X Consortium shall not
# be used in advertising or otherwise to promote the sale, use or other deal-
# ings in this Software without prior written authorization from the X Consor-
# tium.
#
#
# FSF changes to this file are in the public domain.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# 'make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
nl='
'
IFS=" "" $nl"
# set DOITPROG to echo to test this script
# Don't use :- since 4.3BSD and earlier shells don't like it.
doit=${DOITPROG-}
if test -z "$doit"; then
doit_exec=exec
else
doit_exec=$doit
fi
# Put in absolute file names if you don't have them in your path;
# or use environment vars.
chgrpprog=${CHGRPPROG-chgrp}
chmodprog=${CHMODPROG-chmod}
chownprog=${CHOWNPROG-chown}
cmpprog=${CMPPROG-cmp}
cpprog=${CPPROG-cp}
mkdirprog=${MKDIRPROG-mkdir}
mvprog=${MVPROG-mv}
rmprog=${RMPROG-rm}
stripprog=${STRIPPROG-strip}
posix_glob='?'
initialize_posix_glob='
test "$posix_glob" != "?" || {
if (set -f) 2>/dev/null; then
posix_glob=
else
posix_glob=:
fi
}
'
posix_mkdir=
# Desired mode of installed file.
mode=0755
chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
mvcmd=$mvprog
rmcmd="$rmprog -f"
stripcmd=
src=
dst=
dir_arg=
dst_arg=
copy_on_change=false
no_target_directory=
usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
or: $0 [OPTION]... SRCFILES... DIRECTORY
or: $0 [OPTION]... -t DIRECTORY SRCFILES...
or: $0 [OPTION]... -d DIRECTORIES...
In the 1st form, copy SRCFILE to DSTFILE.
In the 2nd and 3rd, copy all SRCFILES to DIRECTORY.
In the 4th, create DIRECTORIES.
Options:
--help display this help and exit.
--version display version info and exit.
-c (ignored)
-C install only if different (preserve the last data modification time)
-d create directories instead of installing files.
-g GROUP $chgrpprog installed files to GROUP.
-m MODE $chmodprog installed files to MODE.
-o USER $chownprog installed files to USER.
-s $stripprog installed files.
-t DIRECTORY install into DIRECTORY.
-T report an error if DSTFILE is a directory.
Environment variables override the default commands:
CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
RMPROG STRIPPROG
"
while test $# -ne 0; do
case $1 in
-c) ;;
-C) copy_on_change=true;;
-d) dir_arg=true;;
-g) chgrpcmd="$chgrpprog $2"
shift;;
--help) echo "$usage"; exit $?;;
-m) mode=$2
case $mode in
*' '* | *' '* | *'
'* | *'*'* | *'?'* | *'['*)
echo "$0: invalid mode: $mode" >&2
exit 1;;
esac
shift;;
-o) chowncmd="$chownprog $2"
shift;;
-s) stripcmd=$stripprog;;
-t) dst_arg=$2
# Protect names problematic for 'test' and other utilities.
case $dst_arg in
-* | [=\(\)!]) dst_arg=./$dst_arg;;
esac
shift;;
-T) no_target_directory=true;;
--version) echo "$0 $scriptversion"; exit $?;;
--) shift
break;;
-*) echo "$0: invalid option: $1" >&2
exit 1;;
*) break;;
esac
shift
done
if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
# When -d is used, all remaining arguments are directories to create.
# When -t is used, the destination is already specified.
# Otherwise, the last argument is the destination. Remove it from $@.
for arg
do
if test -n "$dst_arg"; then
# $@ is not empty: it contains at least $arg.
set fnord "$@" "$dst_arg"
shift # fnord
fi
shift # arg
dst_arg=$arg
# Protect names problematic for 'test' and other utilities.
case $dst_arg in
-* | [=\(\)!]) dst_arg=./$dst_arg;;
esac
done
fi
if test $# -eq 0; then
if test -z "$dir_arg"; then
echo "$0: no input file specified." >&2
exit 1
fi
# It's OK to call 'install-sh -d' without argument.
# This can happen when creating conditional directories.
exit 0
fi
if test -z "$dir_arg"; then
do_exit='(exit $ret); exit $ret'
trap "ret=129; $do_exit" 1
trap "ret=130; $do_exit" 2
trap "ret=141; $do_exit" 13
trap "ret=143; $do_exit" 15
# Set umask so as not to create temps with too-generous modes.
# However, 'strip' requires both read and write access to temps.
case $mode in
# Optimize common cases.
*644) cp_umask=133;;
*755) cp_umask=22;;
*[0-7])
if test -z "$stripcmd"; then
u_plus_rw=
else
u_plus_rw='% 200'
fi
cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
*)
if test -z "$stripcmd"; then
u_plus_rw=
else
u_plus_rw=,u+rw
fi
cp_umask=$mode$u_plus_rw;;
esac
fi
for src
do
# Protect names problematic for 'test' and other utilities.
case $src in
-* | [=\(\)!]) src=./$src;;
esac
if test -n "$dir_arg"; then
dst=$src
dstdir=$dst
test -d "$dstdir"
dstdir_status=$?
else
# Waiting for this to be detected by the "$cpprog $src $dsttmp" command
# might cause directories to be created, which would be especially bad
# if $src (and thus $dsttmp) contains '*'.
if test ! -f "$src" && test ! -d "$src"; then
echo "$0: $src does not exist." >&2
exit 1
fi
if test -z "$dst_arg"; then
echo "$0: no destination specified." >&2
exit 1
fi
dst=$dst_arg
# If destination is a directory, append the input filename; won't work
# if double slashes aren't ignored.
if test -d "$dst"; then
if test -n "$no_target_directory"; then
echo "$0: $dst_arg: Is a directory" >&2
exit 1
fi
dstdir=$dst
dst=$dstdir/`basename "$src"`
dstdir_status=0
else
# Prefer dirname, but fall back on a substitute if dirname fails.
dstdir=`
(dirname "$dst") 2>/dev/null ||
expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$dst" : 'X\(//\)[^/]' \| \
X"$dst" : 'X\(//\)$' \| \
X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
echo X"$dst" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'
`
test -d "$dstdir"
dstdir_status=$?
fi
fi
obsolete_mkdir_used=false
if test $dstdir_status != 0; then
case $posix_mkdir in
'')
# Create intermediate dirs using mode 755 as modified by the umask.
# This is like FreeBSD 'install' as of 1997-10-28.
umask=`umask`
case $stripcmd.$umask in
# Optimize common cases.
*[2367][2367]) mkdir_umask=$umask;;
.*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;
*[0-7])
mkdir_umask=`expr $umask + 22 \
- $umask % 100 % 40 + $umask % 20 \
- $umask % 10 % 4 + $umask % 2
`;;
*) mkdir_umask=$umask,go-w;;
esac
# With -d, create the new directory with the user-specified mode.
# Otherwise, rely on $mkdir_umask.
if test -n "$dir_arg"; then
mkdir_mode=-m$mode
else
mkdir_mode=
fi
posix_mkdir=false
case $umask in
*[123567][0-7][0-7])
# POSIX mkdir -p sets u+wx bits regardless of umask, which
# is incompatible with FreeBSD 'install' when (umask & 300) != 0.
;;
*)
tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
if (umask $mkdir_umask &&
exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
then
if test -z "$dir_arg" || {
# Check for POSIX incompatibilities with -m.
# HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
# other-writable bit of parent directory when it shouldn't.
# FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
ls_ld_tmpdir=`ls -ld "$tmpdir"`
case $ls_ld_tmpdir in
d????-?r-*) different_mode=700;;
d????-?--*) different_mode=755;;
*) false;;
esac &&
$mkdirprog -m$different_mode -p -- "$tmpdir" && {
ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
}
}
then posix_mkdir=:
fi
rmdir "$tmpdir/d" "$tmpdir"
else
# Remove any dirs left behind by ancient mkdir implementations.
rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
fi
trap '' 0;;
esac;;
esac
if
$posix_mkdir && (
umask $mkdir_umask &&
$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
)
then :
else
# The umask is ridiculous, or mkdir does not conform to POSIX,
# or it failed possibly due to a race condition. Create the
# directory the slow way, step by step, checking for races as we go.
case $dstdir in
/*) prefix='/';;
[-=\(\)!]*) prefix='./';;
*) prefix='';;
esac
eval "$initialize_posix_glob"
oIFS=$IFS
IFS=/
$posix_glob set -f
set fnord $dstdir
shift
$posix_glob set +f
IFS=$oIFS
prefixes=
for d
do
test X"$d" = X && continue
prefix=$prefix$d
if test -d "$prefix"; then
prefixes=
else
if $posix_mkdir; then
(umask=$mkdir_umask &&
$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
# Don't fail if two instances are running concurrently.
test -d "$prefix" || exit 1
else
case $prefix in
*\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
*) qprefix=$prefix;;
esac
prefixes="$prefixes '$qprefix'"
fi
fi
prefix=$prefix/
done
if test -n "$prefixes"; then
# Don't fail if two instances are running concurrently.
(umask $mkdir_umask &&
eval "\$doit_exec \$mkdirprog $prefixes") ||
test -d "$dstdir" || exit 1
obsolete_mkdir_used=true
fi
fi
fi
if test -n "$dir_arg"; then
{ test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
{ test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
{ test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
else
# Make a couple of temp file names in the proper directory.
dsttmp=$dstdir/_inst.$$_
rmtmp=$dstdir/_rm.$$_
# Trap to clean up those temp files at exit.
trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
# Copy the file name to the temp name.
(umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&
# and set any options; do chmod last to preserve setuid bits.
#
# If any of these fail, we abort the whole thing. If we want to
# ignore errors from any of these, just make sure not to ignore
# errors from the above "$doit $cpprog $src $dsttmp" command.
#
{ test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
{ test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
{ test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
{ test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&
# If -C, don't bother to copy if it wouldn't change the file.
if $copy_on_change &&
old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` &&
new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` &&
eval "$initialize_posix_glob" &&
$posix_glob set -f &&
set X $old && old=:$2:$4:$5:$6 &&
set X $new && new=:$2:$4:$5:$6 &&
$posix_glob set +f &&
test "$old" = "$new" &&
$cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
then
rm -f "$dsttmp"
else
# Rename the file to the real destination.
$doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||
# The rename failed, perhaps because mv can't rename something else
# to itself, or perhaps because mv is so ancient that it does not
# support -f.
{
# Now remove or move aside any old file at destination location.
# We try this two ways since rm can't unlink itself on some
# systems and the destination file might be busy for other
# reasons. In this case, the final cleanup might fail but the new
# file should still install successfully.
{
test ! -f "$dst" ||
$doit $rmcmd -f "$dst" 2>/dev/null ||
{ $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
{ $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
} ||
{ echo "$0: cannot unlink or rename $dst" >&2
(exit 1); exit 1
}
} &&
# Now rename the file to the real destination.
$doit $mvcmd "$dsttmp" "$dst"
}
fi || exit 1
trap '' 0
fi
done
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
arpack-ng-3.1.5/COPYING 0000644 0001750 0001750 00000003564 12277373057 011364 0000000 0000000
BSD Software License
Pertains to ARPACK and P_ARPACK
Copyright (c) 1996-2008 Rice University.
Developed by D.C. Sorensen, R.B. Lehoucq, C. Yang, and K. Maschhoff.
All rights reserved.
Arpack has been renamed to arpack-ng.
Copyright (c) 2001-2011 - Scilab Enterprises
Updated by Allan Cornet, Sylvestre Ledru.
Copyright (c) 2010 - Jordi Gutiérrez Hermoso (Octave patch)
Copyright (c) 2007 - Sébastien Fabbro (gentoo patch)
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
- Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer listed
in this license in the documentation and/or other materials
provided with the distribution.
- Neither the name of the copyright holders nor the names of its
contributors may be used to endorse or promote products derived from
this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
arpack-ng-3.1.5/CHANGES 0000644 0001750 0001750 00000012573 12277671726 011330 0000000 0000000 arpack-ng - 3.1.5
* Build all examples and run them as tests
* Fix the version of arpack-ng itself
* Switch to automake 1.14.1
[ Ruediger Meier ]
* Do not install test binaries (Closes: #1348)
[ Nikita Styopin ]
* Fix the diagonal matrix example (dndrv5) (Closes: #1397)
-- Sylvestre Ledru Sat, 15 Feb 2014 14:24:42 +0200
arpack-ng - 3.1.4
* libparpack2: missing dependency on MPI:
http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=718790
* Replace LAPACK second function with ARPACK's own arscnd in PARPACK
* Fix issue #1259 in DSEUPD and SSEUPD
The Ritz vector purification step assumes workl(iq) still contains the
original Q matrix. This is however overwritten by the call to xGEQR2
earlier.
.
This patch fixes the issue by making a copy of the last row of the
eigenvector matrix, after it is recomputed after QR by xORM2R. The work
space WORKL(IW+NCV:IW+2*NCV) is not used later in the routine, and can
be used for this.
* Use configure supplied blas and lapack in the pkg-config.
Thanks to Ward Poelmans (Closes: #1320)
* Switch to automake 1.14 + libtool 2.4.2.
Thanks to Ward Poelmans (Closes: #1321)
* dseupd routine may lead to a segmentation fault
Thanks to Edouard Canot (Closes: #1323)
* dsaupd and 'BE' option returns wrong eigenvalues for a SPD matrix
Thanks to Edouard Canot (Closes: #1329)
-- Sylvestre Ledru Mon, 07 Oct 2013 14:24:42 +0200
arpack-ng - 3.1.3
[ Jordi Gutiérrez Hermoso ]
* Replace depcomp symlink with actual file.
* Update libtool usage. Thanks to John W. Eaton .
* Replace arpack.pc with proper autotooled arpack.pc.in
* Add debug.h to TESTS/Makefile.am sources
* "make dist" is functionnal
* Also build the library "libparpacksrcblacs" (PARPACK/UTIL/BLACS/)
-- Sylvestre Ledru Tue, 02 Apr 2013 10:53:08 +0200
arpack-ng - 3.1.2
* Wrong call to pdlamch was causing segfaults
Thanks to Kyrre Sjøbæk for finding the bug and the fix.
* Get rid of the mpif.h occurences in the source code (Closes: #782)
* Compile also PARPACK / MPI example (Closes: #783)
* Configure detected built-in LAPACK and BLAS, but refused to use them
(Closes: #784)
* Fixed division by zero in smlnum by usind p[d,s]lamch instead of the
serial. Thanks to Umberto De Giovannini.
-- Sylvestre Ledru Fri, 22 Jun 2012 22:05:41 +0200
arpack-ng - 3.1.1
* Option --enable-maintainer-mode added to the configure
* --disable-mpi disables the build of parpack (Closes: #714)
* Switch to automake 1.11.3
-- Sylvestre Ledru Mon, 21 May 2012 09:08:41 +0200
arpack-ng - 3.1.0
* Many bug fixes in the parpack lib. It is an old patch from upstream.
Thanks to Viral Shah for pinging us on this subject.
See the PARPACK_CHANGES file for the details.
* Change the bug report from arpack@caam.rice.edu to
http://forge.scilab.org/index.php/p/arpack-ng/issues/
* Provide a M4 macro (detect_arpack_bug.m4) to check if the underlying
arpack is buggy (ie not arpack-ng). This allows developper applications
to perform the check in their autotools build system (configure).
* Fixed a lack of appropriate bounds check in DNAUP2. Thanks to Pauli Virtanen
for the patch (Closes: #632)
* Update of the doc about TOL in dnaupd.
* Reorder bug fixed when eigenvectors are requested and the resulting
number of converged eigenvalues is less than the number requested.
Patches from Tim Mitchell. (Closes: #664)
* TESTS/ directory added and built.
-- Sylvestre Ledru Wed, 22 Feb 2012 10:58:39 +0100
arpack-ng - 3.0.2
* Fix a long line in pznaup2.f which was showing some wrong symbols
(Closes: #620)
* README content updated regarding ARPACK-NG
* arpack.pc (pkg-config) file added
* Update the title & version in the configure.ac
* Always search for MPILIBS (in order to have the variable correctly set)
* Explicitly link against MPI fortran libs for parpack
-- Sylvestre Ledru Wed, 28 Dec 2011 13:45:53 +0100
arpack-ng - 3.0.1
* libtool was missing (Closes: #615)
* Missing license information (Closes: #614)
* TODO added
-- Sylvestre Ledru Tue, 13 Dec 2011 16:33:25 +0100
arpack-ng - 3.0
* Patches from Scilab
second_NONE used by default (TO DO replace by second in LAPACK)
second_NONE works with all fortrans compilers (used by default with Scilab)
sneupd.f, cneupd.f: modified for scilab add a check on nconv value (Scilab bug fix)
dnaupd.f: modified NEV Integer: INPUT/OUTPUT before only INPUT (Scilab bug fix)
* Patches from Octave: (Thanks to John W. EATON)
dneupd.f: Restore value of nconv
dseupd.f: Restore value of nconv
sseupd.f: Change GOTO target to eliminate warning about landing on end if.
zneupd.f: Restore value of nconv
* Compilation
Apply gentoo patches to use an autotools build system
Build system updated to build with Visual Studio 2010 + Intel fortran 2011 compiles on Windows.
Specify the SONAME to libarpack.so.2 (no API/ABI changes compare to version 2.0)
-- Sylvestre Ledru Sat, 10 Dec 2011 20:32:45 +0100
arpack-ng-3.1.5/missing 0000755 0001750 0001750 00000015331 12277373057 011723 0000000 0000000 #! /bin/sh
# Common wrapper for a few potentially missing GNU programs.
scriptversion=2012-06-26.16; # UTC
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
# Originally written by Fran,cois Pinard , 1996.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
if test $# -eq 0; then
echo 1>&2 "Try '$0 --help' for more information"
exit 1
fi
case $1 in
--is-lightweight)
# Used by our autoconf macros to check whether the available missing
# script is modern enough.
exit 0
;;
--run)
# Back-compat with the calling convention used by older automake.
shift
;;
-h|--h|--he|--hel|--help)
echo "\
$0 [OPTION]... PROGRAM [ARGUMENT]...
Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due
to PROGRAM being missing or too old.
Options:
-h, --help display this help and exit
-v, --version output version information and exit
Supported PROGRAM values:
aclocal autoconf autoheader autom4te automake makeinfo
bison yacc flex lex help2man
Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and
'g' are ignored when checking the name.
Send bug reports to ."
exit $?
;;
-v|--v|--ve|--ver|--vers|--versi|--versio|--version)
echo "missing $scriptversion (GNU Automake)"
exit $?
;;
-*)
echo 1>&2 "$0: unknown '$1' option"
echo 1>&2 "Try '$0 --help' for more information"
exit 1
;;
esac
# Run the given program, remember its exit status.
"$@"; st=$?
# If it succeeded, we are done.
test $st -eq 0 && exit 0
# Also exit now if we it failed (or wasn't found), and '--version' was
# passed; such an option is passed most likely to detect whether the
# program is present and works.
case $2 in --version|--help) exit $st;; esac
# Exit code 63 means version mismatch. This often happens when the user
# tries to use an ancient version of a tool on a file that requires a
# minimum version.
if test $st -eq 63; then
msg="probably too old"
elif test $st -eq 127; then
# Program was missing.
msg="missing on your system"
else
# Program was found and executed, but failed. Give up.
exit $st
fi
perl_URL=http://www.perl.org/
flex_URL=http://flex.sourceforge.net/
gnu_software_URL=http://www.gnu.org/software
program_details ()
{
case $1 in
aclocal|automake)
echo "The '$1' program is part of the GNU Automake package:"
echo "<$gnu_software_URL/automake>"
echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/autoconf>"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
autoconf|autom4te|autoheader)
echo "The '$1' program is part of the GNU Autoconf package:"
echo "<$gnu_software_URL/autoconf/>"
echo "It also requires GNU m4 and Perl in order to run:"
echo "<$gnu_software_URL/m4/>"
echo "<$perl_URL>"
;;
esac
}
give_advice ()
{
# Normalize program name to check for.
normalized_program=`echo "$1" | sed '
s/^gnu-//; t
s/^gnu//; t
s/^g//; t'`
printf '%s\n' "'$1' is $msg."
configure_deps="'configure.ac' or m4 files included by 'configure.ac'"
case $normalized_program in
autoconf*)
echo "You should only need it if you modified 'configure.ac',"
echo "or m4 files included by it."
program_details 'autoconf'
;;
autoheader*)
echo "You should only need it if you modified 'acconfig.h' or"
echo "$configure_deps."
program_details 'autoheader'
;;
automake*)
echo "You should only need it if you modified 'Makefile.am' or"
echo "$configure_deps."
program_details 'automake'
;;
aclocal*)
echo "You should only need it if you modified 'acinclude.m4' or"
echo "$configure_deps."
program_details 'aclocal'
;;
autom4te*)
echo "You might have modified some maintainer files that require"
echo "the 'automa4te' program to be rebuilt."
program_details 'autom4te'
;;
bison*|yacc*)
echo "You should only need it if you modified a '.y' file."
echo "You may want to install the GNU Bison package:"
echo "<$gnu_software_URL/bison/>"
;;
lex*|flex*)
echo "You should only need it if you modified a '.l' file."
echo "You may want to install the Fast Lexical Analyzer package:"
echo "<$flex_URL>"
;;
help2man*)
echo "You should only need it if you modified a dependency" \
"of a man page."
echo "You may want to install the GNU Help2man package:"
echo "<$gnu_software_URL/help2man/>"
;;
makeinfo*)
echo "You should only need it if you modified a '.texi' file, or"
echo "any other file indirectly affecting the aspect of the manual."
echo "You might want to install the Texinfo package:"
echo "<$gnu_software_URL/texinfo/>"
echo "The spurious makeinfo call might also be the consequence of"
echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might"
echo "want to install GNU make:"
echo "<$gnu_software_URL/make/>"
;;
*)
echo "You might have modified some files without having the proper"
echo "tools for further handling them. Check the 'README' file, it"
echo "often tells you about the needed prerequisites for installing"
echo "this package. You may also peek at any GNU archive site, in"
echo "case some other package contains this missing '$1' program."
;;
esac
}
give_advice "$1" | sed -e '1s/^/WARNING: /' \
-e '2,$s/^/ /' >&2
# Propagate the correct exit status (expected to be 127 for a program
# not found, 63 for a program that failed due to version mismatch).
exit $st
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
arpack-ng-3.1.5/VISUAL_STUDIO/ 0000755 0001750 0001750 00000000000 12277373057 012473 5 0000000 0000000 arpack-ng-3.1.5/VISUAL_STUDIO/lapack_imports.def 0000644 0001750 0001750 00000001332 12277373057 016102 0000000 0000000 LIBRARY lapack.dll
EXPORTS
dlamch_
dlapy2_
zlaset_
zlahqr_
ztrsen_
zgeqr2_
zunm2r_
zlacpy_
ztrevc_
dlabad_
dlaset_
dlanhs_
dlartg_
dlarfg_
dlarf_
dlarnv_
dlaruv_
dlacpy_
dswap_
dlascl_
dtrevc_
dlanst_
dlaev2_
dlae2_
dlasr_
dlasrt_
zlascl_
zlanhs_
dsteqr_
dgeqr2_
dorm2r_
dlahqr_
dtrsen_
dlanv2_
zlarnv_
zlartg_
;
slamch_
slapy2_
cswap_
slabad_
claset_
slarf_
strmm_
strevc_
strsen_
slahqr_
saxpy_
sger_
slacpy_
sorm2r_
sgeqr2_
ssteqr_
slaset_
slasrt_
slartg_
slae2_
slasr_
slaev2_
slascl_
slanst_
sscal_
clarnv_
sswap_
cgeru_
ctrmm_
ctrevc_
clanhs_
clartg_
cscal_
cgemv_
ccopy_
clacpy_
caxpy_
slanhs_
scopy_
slarfg_
slanv2_
srot_
csscal_
clascl_
cdotc_
scnrm2_
slarnv_
sdot_
snrm2_
sgemv_
clahqr_
ctrsen_
cgeqr2_
cunm2r_
arpack-ng-3.1.5/VISUAL_STUDIO/arpack-ng.sln 0000644 0001750 0001750 00000003753 12277373057 015004 0000000 0000000 
Microsoft Visual Studio Solution File, Format Version 11.00
# Visual Studio 2010
Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "arpack-ng", "arpack-ng.vfproj", "{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug MKL|Win32 = Debug MKL|Win32
Debug MKL|x64 = Debug MKL|x64
Debug|Win32 = Debug|Win32
Debug|x64 = Debug|x64
Release MKL|Win32 = Release MKL|Win32
Release MKL|x64 = Release MKL|x64
Release|Win32 = Release|Win32
Release|x64 = Release|x64
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug MKL|Win32.ActiveCfg = Debug MKL|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug MKL|Win32.Build.0 = Debug MKL|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug MKL|x64.ActiveCfg = Debug MKL|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug MKL|x64.Build.0 = Debug MKL|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug|Win32.ActiveCfg = Debug|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug|Win32.Build.0 = Debug|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug|x64.ActiveCfg = Debug|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Debug|x64.Build.0 = Debug|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release MKL|Win32.ActiveCfg = Release MKL|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release MKL|Win32.Build.0 = Release MKL|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release MKL|x64.ActiveCfg = Release MKL|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release MKL|x64.Build.0 = Release MKL|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release|Win32.ActiveCfg = Release|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release|Win32.Build.0 = Release|Win32
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release|x64.ActiveCfg = Release|x64
{34F953E3-9A2C-4359-A8C5-41CEBD0ECE45}.Release|x64.Build.0 = Release|x64
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
EndGlobal
arpack-ng-3.1.5/VISUAL_STUDIO/blas_imports.def 0000644 0001750 0001750 00000003264 12277373057 015576 0000000 0000000 LIBRARY blas.dll
EXPORTS
dasum_
dasum = dasum_
daxpy_
daxpy = daxpy_
dcopy_
dcopy = dcopy_
ddot_
ddot = ddot_
dgbmv_
dgbmv = dgbmv_
dgemm_
dgemm = dgemm_
dgemv_
dgemv = dgemv_
dger_
dger = dger_
dnrm2_
dnrm2 = dnrm2_
drot_
drot = drot_
drotg_
drotg = drotg_
dsbmv_
dsbmv = dsbmv_
dscal_
dscal = dscal_
dspmv_
dspmv = dspmv_
dspr_
dspr = dspr_
dspr2_
dspr2 = dspr2_
dswap_
dswap = dswap_
dsymm_
dsymm = dsymm_
dsymv_
dsymv = dsymv_
dsyr_
dsyr = dsyr_
dsyr2_
dsyr2 = dsyr2_
dsyr2k_
dsyr2k = dsyr2k_
dsyrk_
dsyrk = dsyrk_
dtbmv_
dtbmv = dtbmv_
dtbsv_
dtbsv = dtbsv_
dtpmv_
dtpmv = dtpmv_
dtpsv_
dtpsv = dtpsv_
dtrmm_
dtrmm = dtrmm_
dtrmv_
dtrmv = dtrmv_
dtrsm_
dtrsm = dtrsm_
dtrsv_
dtrsv = dtrsv_
dzasum_
dzasum = dzasum_
dznrm2_
dznrm2 = dznrm2_
idamax_
idamax = idamax_
izamax_
izamax = izamax_
zaxpy_
zaxpy = zaxpy_
zcopy_
zcopy = zcopy_
zdotc_
zdotc = zdotc_
zdotu_
zdotu = zdotu_
zdscal_
zdscal = zdscal_
zgbmv_
zgbmv = zgbmv_
zgemm_
zgemm = zgemm_
zgemv_
zgemv = zgemv_
zgerc_
zgerc = zgerc_
zgeru_
zgeru = zgeru_
zhbmv_
zhbmv = zhbmv_
zhemm_
zhemm = zhemm_
zhemv_
zhemv = zhemv_
zher_
zher = zher_
zher2_
zher2 = zher2_
zher2k_
zher2k = zher2k_
zherk_
zherk = zherk_
zhpmv_
zhpmv = zhpmv_
zhpr_
zhpr = zhpr_
zhpr2_
zhpr2 = zhpr2_
zrotg_
zrotg = zrotg_
zscal_
zscal = zscal_
zswap_
zswap = zswap_
zsymm_
zsymm = zsymm_
zsyr2k_
zsyr2k = zsyr2k_
zsyrk_
zsyrk = zsyrk_
ztbmv_
ztbmv = ztbmv_
ztbsv_
ztbsv = ztbsv_
ztpmv_
ztpmv = ztpmv_
ztpsv_
ztpsv = ztpsv_
ztrmm_
ztrmm =ztrmm_
ztrmv_
ztrmv = ztrmv_
ztrsm_
ztrsm = ztrsm_
ztrsv_
ztrsv = ztrsv_
xerbla_
xerbla = xerbla_
arpack-ng-3.1.5/VISUAL_STUDIO/arpack-ng_exports.def 0000644 0001750 0001750 00000000640 12277373057 016522 0000000 0000000 LIBRARY arpack-ng.dll
EXPORTS
cmout_
cvout_
dgetv0_
dlaqrb_
dmout_
dnaitr_
dnapps_
dnaup2_
dnaupd_
dnconv_
dneigh_
dneupd_
dngets_
dsaitr_
dsapps_
dsaup2_
dsaupd_
dsconv_
dseigt_
dsesrt_
dseupd_
dsgets_
dsortc_
dsortr_
dstatn_
dstats_
dstqrb_
dvout_
icnteq_
iswap_
ivout_
arscnd_
smout_
zgetv0_
znaitr_
znapps_
znaup2_
znaupd_
zneigh_
zneupd_
zngets_
zsortc_
zstatn_
arpack-ng-3.1.5/VISUAL_STUDIO/arpack-ng.rc 0000644 0001750 0001750 00000003506 12277373057 014610 0000000 0000000 //Microsoft Developer Studio generated resource script.
//
#define APSTUDIO_READONLY_SYMBOLS
/////////////////////////////////////////////////////////////////////////////
//
// Generated from the TEXTINCLUDE 2 resource.
//
#include "winres.h"
#include "winver.h"
/////////////////////////////////////////////////////////////////////////////
#undef APSTUDIO_READONLY_SYMBOLS
/////////////////////////////////////////////////////////////////////////////
// Neutral resources
#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU)
#ifdef _WIN32
LANGUAGE LANG_NEUTRAL, SUBLANG_NEUTRAL
#pragma code_page(1252)
#endif //_WIN32
#endif // Neutral resources
/////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////
// English (U.S.) resources
#if !defined(AFX_RESOURCE_DLL) || defined(AFX_TARG_ENU)
#ifdef _WIN32
LANGUAGE LANG_ENGLISH, SUBLANG_ENGLISH_US
#pragma code_page(1252)
#endif //_WIN32
#ifdef APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// TEXTINCLUDE
//
1 TEXTINCLUDE
BEGIN
END
2 TEXTINCLUDE
BEGIN
"#include ""winres.h""\r\n"
"#include ""winver.h""\r\n"
"\0"
END
3 TEXTINCLUDE
BEGIN
"\r\n"
"\0"
END
#endif // APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// String Table
//
STRINGTABLE
BEGIN
0 " "
END
#endif // English (U.S.) resources
/////////////////////////////////////////////////////////////////////////////
#ifndef APSTUDIO_INVOKED
/////////////////////////////////////////////////////////////////////////////
//
// Generated from the TEXTINCLUDE 3 resource.
//
/////////////////////////////////////////////////////////////////////////////
#endif // not APSTUDIO_INVOKED
arpack-ng-3.1.5/VISUAL_STUDIO/blasplus_imports.def 0000644 0001750 0001750 00000005221 12277373057 016475 0000000 0000000 LIBRARY blasplus.dll
EXPORTS
dasum_ @1
dasum = dasum_
daxpy_ @2
daxpy = daxpy_
dcopy_ @3
dcopy = dcopy_
ddot_ @4
ddot = ddot_
dgbmv_ @5
dgbmv = dgbmv_
dgemm_ @6
dgemm = dgemm_
dgemv_ @7
dgemv = dgemv_
dger_ @8
dger = dger_
dnrm2_ @9
dnrm2 = dnrm2_
drot_ @10
drot = drot_
drotg_ @11
drotg = drotg_
dsbmv_ @12
dsbmv = dsbmv_
dscal_ @13
dscal = dscal_
dspmv_ @14
dspmv = dspmv_
dspr_ @15
dspr = dspr_
dspr2_ @16
dspr2 = dspr2_
dswap_ @17
dswap = dswap_
dsymm_ @18
dsymm = dsymm_
dsymv_ @19
dsymv = dsymv_
dsyr_ @20
dsyr = dsyr_
dsyr2_ @21
dsyr2 = dsyr2_
dsyr2k_ @22
dsyr2k = dsyr2k_
dsyrk_ @23
dsyrk = dsyrk_
dtbmv_ @24
dtbmv = dtbmv_
dtbsv_ @25
dtbsv = dtbsv_
dtpmv_ @26
dtpmv = dtpmv_
dtpsv_ @27
dtpsv = dtpsv_
dtrmm_ @28
dtrmm = dtrmm_
dtrmv_ @29
dtrmv = dtrmv_
dtrsm_ @30
dtrsm = dtrsm_
dtrsv_ @31
dtrsv = dtrsv_
dzasum_ @32
dzasum = dzasum_
dznrm2_ @33
dznrm2 = dznrm2_
idamax_ @34
idamax = idamax_
izamax_ @35
izamax = izamax_
xerbla_ @36
xerbla = xerbla_
zaxpy_ @37
zaxpy = zaxpy_
zcopy_ @38
zcopy = zcopy_
zdotc_ @39
zdotc = zdotc_
zdotu_ @40
zdotu = zdotu_
zdscal_ @41
zdscal = zdscal_
zgbmv_ @42
zgbmv = zgbmv_
zgemm_ @43
zgemm = zgemm_
zgemv_ @44
zgemv = zgemv_
zgerc_ @45
zgerc = zgerc_
zgeru_ @46
zgeru = zgeru_
zhbmv_ @47
zhbmv = zhbmv_
zhemm_ @48
zhemm = zhemm_
zhemv_ @49
zhemv = zhemv_
zher_ @50
zher = zher_
zher2_ @51
zher2 = zher2_
zher2k_ @52
zher2k = zher2k_
zherk_ @53
zherk = zherk_
zhpmv_ @54
zhpmv = zhpmv_
zhpr_ @55
zhpr = zhpr_
zhpr2_ @56
zhpr2 = zhpr2_
zrotg_ @57
zrotg = zrotg_
zscal_ @58
zscal = zscal_
zswap_ @59
zswap = zswap_
zsymm_ @60
zsymm = zsymm_
zsyr2k_ @61
zsyr2k = zsyr2k_
zsyrk_ @62
zsyrk = zsyrk_
ztbmv_ @63
ztbmv = ztbmv_
ztbsv_ @64
ztbsv = ztbsv_
ztpmv_ @65
ztpmv = ztpmv_
ztpsv_ @66
ztpsv = ztpsv_
ztrmm_ @67
ztrmm =ztrmm_
ztrmv_ @68
ztrmv = ztrmv_
ztrsm_ @69
ztrsm = ztrsm_
ztrsv_ @70
ztrsv = ztrsv_
arpack-ng-3.1.5/VISUAL_STUDIO/arpack-ng.vfproj 0000644 0001750 0001750 00000044420 12277373057 015512 0000000 0000000
arpack-ng-3.1.5/m4/ 0000755 0001750 0001750 00000000000 12277671743 010724 5 0000000 0000000 arpack-ng-3.1.5/m4/ltoptions.m4 0000644 0001750 0001750 00000030073 12277373057 013141 0000000 0000000 # Helper functions for option handling. -*- Autoconf -*-
#
# Copyright (C) 2004, 2005, 2007, 2008, 2009 Free Software Foundation,
# Inc.
# Written by Gary V. Vaughan, 2004
#
# This file is free software; the Free Software Foundation gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
# serial 7 ltoptions.m4
# This is to help aclocal find these macros, as it can't see m4_define.
AC_DEFUN([LTOPTIONS_VERSION], [m4_if([1])])
# _LT_MANGLE_OPTION(MACRO-NAME, OPTION-NAME)
# ------------------------------------------
m4_define([_LT_MANGLE_OPTION],
[[_LT_OPTION_]m4_bpatsubst($1__$2, [[^a-zA-Z0-9_]], [_])])
# _LT_SET_OPTION(MACRO-NAME, OPTION-NAME)
# ---------------------------------------
# Set option OPTION-NAME for macro MACRO-NAME, and if there is a
# matching handler defined, dispatch to it. Other OPTION-NAMEs are
# saved as a flag.
m4_define([_LT_SET_OPTION],
[m4_define(_LT_MANGLE_OPTION([$1], [$2]))dnl
m4_ifdef(_LT_MANGLE_DEFUN([$1], [$2]),
_LT_MANGLE_DEFUN([$1], [$2]),
[m4_warning([Unknown $1 option `$2'])])[]dnl
])
# _LT_IF_OPTION(MACRO-NAME, OPTION-NAME, IF-SET, [IF-NOT-SET])
# ------------------------------------------------------------
# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
m4_define([_LT_IF_OPTION],
[m4_ifdef(_LT_MANGLE_OPTION([$1], [$2]), [$3], [$4])])
# _LT_UNLESS_OPTIONS(MACRO-NAME, OPTION-LIST, IF-NOT-SET)
# -------------------------------------------------------
# Execute IF-NOT-SET unless all options in OPTION-LIST for MACRO-NAME
# are set.
m4_define([_LT_UNLESS_OPTIONS],
[m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
[m4_ifdef(_LT_MANGLE_OPTION([$1], _LT_Option),
[m4_define([$0_found])])])[]dnl
m4_ifdef([$0_found], [m4_undefine([$0_found])], [$3
])[]dnl
])
# _LT_SET_OPTIONS(MACRO-NAME, OPTION-LIST)
# ----------------------------------------
# OPTION-LIST is a space-separated list of Libtool options associated
# with MACRO-NAME. If any OPTION has a matching handler declared with
# LT_OPTION_DEFINE, dispatch to that macro; otherwise complain about
# the unknown option and exit.
m4_defun([_LT_SET_OPTIONS],
[# Set options
m4_foreach([_LT_Option], m4_split(m4_normalize([$2])),
[_LT_SET_OPTION([$1], _LT_Option)])
m4_if([$1],[LT_INIT],[
dnl
dnl Simply set some default values (i.e off) if boolean options were not
dnl specified:
_LT_UNLESS_OPTIONS([LT_INIT], [dlopen], [enable_dlopen=no
])
_LT_UNLESS_OPTIONS([LT_INIT], [win32-dll], [enable_win32_dll=no
])
dnl
dnl If no reference was made to various pairs of opposing options, then
dnl we run the default mode handler for the pair. For example, if neither
dnl `shared' nor `disable-shared' was passed, we enable building of shared
dnl archives by default:
_LT_UNLESS_OPTIONS([LT_INIT], [shared disable-shared], [_LT_ENABLE_SHARED])
_LT_UNLESS_OPTIONS([LT_INIT], [static disable-static], [_LT_ENABLE_STATIC])
_LT_UNLESS_OPTIONS([LT_INIT], [pic-only no-pic], [_LT_WITH_PIC])
_LT_UNLESS_OPTIONS([LT_INIT], [fast-install disable-fast-install],
[_LT_ENABLE_FAST_INSTALL])
])
])# _LT_SET_OPTIONS
## --------------------------------- ##
## Macros to handle LT_INIT options. ##
## --------------------------------- ##
# _LT_MANGLE_DEFUN(MACRO-NAME, OPTION-NAME)
# -----------------------------------------
m4_define([_LT_MANGLE_DEFUN],
[[_LT_OPTION_DEFUN_]m4_bpatsubst(m4_toupper([$1__$2]), [[^A-Z0-9_]], [_])])
# LT_OPTION_DEFINE(MACRO-NAME, OPTION-NAME, CODE)
# -----------------------------------------------
m4_define([LT_OPTION_DEFINE],
[m4_define(_LT_MANGLE_DEFUN([$1], [$2]), [$3])[]dnl
])# LT_OPTION_DEFINE
# dlopen
# ------
LT_OPTION_DEFINE([LT_INIT], [dlopen], [enable_dlopen=yes
])
AU_DEFUN([AC_LIBTOOL_DLOPEN],
[_LT_SET_OPTION([LT_INIT], [dlopen])
AC_DIAGNOSE([obsolete],
[$0: Remove this warning and the call to _LT_SET_OPTION when you
put the `dlopen' option into LT_INIT's first parameter.])
])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_DLOPEN], [])
# win32-dll
# ---------
# Declare package support for building win32 dll's.
LT_OPTION_DEFINE([LT_INIT], [win32-dll],
[enable_win32_dll=yes
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*)
AC_CHECK_TOOL(AS, as, false)
AC_CHECK_TOOL(DLLTOOL, dlltool, false)
AC_CHECK_TOOL(OBJDUMP, objdump, false)
;;
esac
test -z "$AS" && AS=as
_LT_DECL([], [AS], [1], [Assembler program])dnl
test -z "$DLLTOOL" && DLLTOOL=dlltool
_LT_DECL([], [DLLTOOL], [1], [DLL creation program])dnl
test -z "$OBJDUMP" && OBJDUMP=objdump
_LT_DECL([], [OBJDUMP], [1], [Object dumper program])dnl
])# win32-dll
AU_DEFUN([AC_LIBTOOL_WIN32_DLL],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
_LT_SET_OPTION([LT_INIT], [win32-dll])
AC_DIAGNOSE([obsolete],
[$0: Remove this warning and the call to _LT_SET_OPTION when you
put the `win32-dll' option into LT_INIT's first parameter.])
])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_WIN32_DLL], [])
# _LT_ENABLE_SHARED([DEFAULT])
# ----------------------------
# implement the --enable-shared flag, and supports the `shared' and
# `disable-shared' LT_INIT options.
# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
m4_define([_LT_ENABLE_SHARED],
[m4_define([_LT_ENABLE_SHARED_DEFAULT], [m4_if($1, no, no, yes)])dnl
AC_ARG_ENABLE([shared],
[AS_HELP_STRING([--enable-shared@<:@=PKGS@:>@],
[build shared libraries @<:@default=]_LT_ENABLE_SHARED_DEFAULT[@:>@])],
[p=${PACKAGE-default}
case $enableval in
yes) enable_shared=yes ;;
no) enable_shared=no ;;
*)
enable_shared=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_shared=yes
fi
done
IFS="$lt_save_ifs"
;;
esac],
[enable_shared=]_LT_ENABLE_SHARED_DEFAULT)
_LT_DECL([build_libtool_libs], [enable_shared], [0],
[Whether or not to build shared libraries])
])# _LT_ENABLE_SHARED
LT_OPTION_DEFINE([LT_INIT], [shared], [_LT_ENABLE_SHARED([yes])])
LT_OPTION_DEFINE([LT_INIT], [disable-shared], [_LT_ENABLE_SHARED([no])])
# Old names:
AC_DEFUN([AC_ENABLE_SHARED],
[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[shared])
])
AC_DEFUN([AC_DISABLE_SHARED],
[_LT_SET_OPTION([LT_INIT], [disable-shared])
])
AU_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)])
AU_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AM_ENABLE_SHARED], [])
dnl AC_DEFUN([AM_DISABLE_SHARED], [])
# _LT_ENABLE_STATIC([DEFAULT])
# ----------------------------
# implement the --enable-static flag, and support the `static' and
# `disable-static' LT_INIT options.
# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
m4_define([_LT_ENABLE_STATIC],
[m4_define([_LT_ENABLE_STATIC_DEFAULT], [m4_if($1, no, no, yes)])dnl
AC_ARG_ENABLE([static],
[AS_HELP_STRING([--enable-static@<:@=PKGS@:>@],
[build static libraries @<:@default=]_LT_ENABLE_STATIC_DEFAULT[@:>@])],
[p=${PACKAGE-default}
case $enableval in
yes) enable_static=yes ;;
no) enable_static=no ;;
*)
enable_static=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_static=yes
fi
done
IFS="$lt_save_ifs"
;;
esac],
[enable_static=]_LT_ENABLE_STATIC_DEFAULT)
_LT_DECL([build_old_libs], [enable_static], [0],
[Whether or not to build static libraries])
])# _LT_ENABLE_STATIC
LT_OPTION_DEFINE([LT_INIT], [static], [_LT_ENABLE_STATIC([yes])])
LT_OPTION_DEFINE([LT_INIT], [disable-static], [_LT_ENABLE_STATIC([no])])
# Old names:
AC_DEFUN([AC_ENABLE_STATIC],
[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[static])
])
AC_DEFUN([AC_DISABLE_STATIC],
[_LT_SET_OPTION([LT_INIT], [disable-static])
])
AU_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)])
AU_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AM_ENABLE_STATIC], [])
dnl AC_DEFUN([AM_DISABLE_STATIC], [])
# _LT_ENABLE_FAST_INSTALL([DEFAULT])
# ----------------------------------
# implement the --enable-fast-install flag, and support the `fast-install'
# and `disable-fast-install' LT_INIT options.
# DEFAULT is either `yes' or `no'. If omitted, it defaults to `yes'.
m4_define([_LT_ENABLE_FAST_INSTALL],
[m4_define([_LT_ENABLE_FAST_INSTALL_DEFAULT], [m4_if($1, no, no, yes)])dnl
AC_ARG_ENABLE([fast-install],
[AS_HELP_STRING([--enable-fast-install@<:@=PKGS@:>@],
[optimize for fast installation @<:@default=]_LT_ENABLE_FAST_INSTALL_DEFAULT[@:>@])],
[p=${PACKAGE-default}
case $enableval in
yes) enable_fast_install=yes ;;
no) enable_fast_install=no ;;
*)
enable_fast_install=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_fast_install=yes
fi
done
IFS="$lt_save_ifs"
;;
esac],
[enable_fast_install=]_LT_ENABLE_FAST_INSTALL_DEFAULT)
_LT_DECL([fast_install], [enable_fast_install], [0],
[Whether or not to optimize for fast installation])dnl
])# _LT_ENABLE_FAST_INSTALL
LT_OPTION_DEFINE([LT_INIT], [fast-install], [_LT_ENABLE_FAST_INSTALL([yes])])
LT_OPTION_DEFINE([LT_INIT], [disable-fast-install], [_LT_ENABLE_FAST_INSTALL([no])])
# Old names:
AU_DEFUN([AC_ENABLE_FAST_INSTALL],
[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[fast-install])
AC_DIAGNOSE([obsolete],
[$0: Remove this warning and the call to _LT_SET_OPTION when you put
the `fast-install' option into LT_INIT's first parameter.])
])
AU_DEFUN([AC_DISABLE_FAST_INSTALL],
[_LT_SET_OPTION([LT_INIT], [disable-fast-install])
AC_DIAGNOSE([obsolete],
[$0: Remove this warning and the call to _LT_SET_OPTION when you put
the `disable-fast-install' option into LT_INIT's first parameter.])
])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_ENABLE_FAST_INSTALL], [])
dnl AC_DEFUN([AM_DISABLE_FAST_INSTALL], [])
# _LT_WITH_PIC([MODE])
# --------------------
# implement the --with-pic flag, and support the `pic-only' and `no-pic'
# LT_INIT options.
# MODE is either `yes' or `no'. If omitted, it defaults to `both'.
m4_define([_LT_WITH_PIC],
[AC_ARG_WITH([pic],
[AS_HELP_STRING([--with-pic@<:@=PKGS@:>@],
[try to use only PIC/non-PIC objects @<:@default=use both@:>@])],
[lt_p=${PACKAGE-default}
case $withval in
yes|no) pic_mode=$withval ;;
*)
pic_mode=default
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for lt_pkg in $withval; do
IFS="$lt_save_ifs"
if test "X$lt_pkg" = "X$lt_p"; then
pic_mode=yes
fi
done
IFS="$lt_save_ifs"
;;
esac],
[pic_mode=default])
test -z "$pic_mode" && pic_mode=m4_default([$1], [default])
_LT_DECL([], [pic_mode], [0], [What type of objects to build])dnl
])# _LT_WITH_PIC
LT_OPTION_DEFINE([LT_INIT], [pic-only], [_LT_WITH_PIC([yes])])
LT_OPTION_DEFINE([LT_INIT], [no-pic], [_LT_WITH_PIC([no])])
# Old name:
AU_DEFUN([AC_LIBTOOL_PICMODE],
[_LT_SET_OPTION([LT_INIT], [pic-only])
AC_DIAGNOSE([obsolete],
[$0: Remove this warning and the call to _LT_SET_OPTION when you
put the `pic-only' option into LT_INIT's first parameter.])
])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_PICMODE], [])
## ----------------- ##
## LTDL_INIT Options ##
## ----------------- ##
m4_define([_LTDL_MODE], [])
LT_OPTION_DEFINE([LTDL_INIT], [nonrecursive],
[m4_define([_LTDL_MODE], [nonrecursive])])
LT_OPTION_DEFINE([LTDL_INIT], [recursive],
[m4_define([_LTDL_MODE], [recursive])])
LT_OPTION_DEFINE([LTDL_INIT], [subproject],
[m4_define([_LTDL_MODE], [subproject])])
m4_define([_LTDL_TYPE], [])
LT_OPTION_DEFINE([LTDL_INIT], [installable],
[m4_define([_LTDL_TYPE], [installable])])
LT_OPTION_DEFINE([LTDL_INIT], [convenience],
[m4_define([_LTDL_TYPE], [convenience])])
arpack-ng-3.1.5/m4/libtool.m4 0000644 0001750 0001750 00001057432 12277373057 012563 0000000 0000000 # libtool.m4 - Configure libtool for the host system. -*-Autoconf-*-
#
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# Written by Gordon Matzigkeit, 1996
#
# This file is free software; the Free Software Foundation gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
m4_define([_LT_COPYING], [dnl
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# Written by Gordon Matzigkeit, 1996
#
# This file is part of GNU Libtool.
#
# GNU Libtool is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# As a special exception to the GNU General Public License,
# if you distribute this file as part of a program or library that
# is built using GNU Libtool, you may include this file under the
# same distribution terms that you use for the rest of that program.
#
# GNU Libtool is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Libtool; see the file COPYING. If not, a copy
# can be downloaded from http://www.gnu.org/licenses/gpl.html, or
# obtained by writing to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
])
# serial 57 LT_INIT
# LT_PREREQ(VERSION)
# ------------------
# Complain and exit if this libtool version is less that VERSION.
m4_defun([LT_PREREQ],
[m4_if(m4_version_compare(m4_defn([LT_PACKAGE_VERSION]), [$1]), -1,
[m4_default([$3],
[m4_fatal([Libtool version $1 or higher is required],
63)])],
[$2])])
# _LT_CHECK_BUILDDIR
# ------------------
# Complain if the absolute build directory name contains unusual characters
m4_defun([_LT_CHECK_BUILDDIR],
[case `pwd` in
*\ * | *\ *)
AC_MSG_WARN([Libtool does not cope well with whitespace in `pwd`]) ;;
esac
])
# LT_INIT([OPTIONS])
# ------------------
AC_DEFUN([LT_INIT],
[AC_PREREQ([2.58])dnl We use AC_INCLUDES_DEFAULT
AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl
AC_BEFORE([$0], [LT_LANG])dnl
AC_BEFORE([$0], [LT_OUTPUT])dnl
AC_BEFORE([$0], [LTDL_INIT])dnl
m4_require([_LT_CHECK_BUILDDIR])dnl
dnl Autoconf doesn't catch unexpanded LT_ macros by default:
m4_pattern_forbid([^_?LT_[A-Z_]+$])dnl
m4_pattern_allow([^(_LT_EOF|LT_DLGLOBAL|LT_DLLAZY_OR_NOW|LT_MULTI_MODULE)$])dnl
dnl aclocal doesn't pull ltoptions.m4, ltsugar.m4, or ltversion.m4
dnl unless we require an AC_DEFUNed macro:
AC_REQUIRE([LTOPTIONS_VERSION])dnl
AC_REQUIRE([LTSUGAR_VERSION])dnl
AC_REQUIRE([LTVERSION_VERSION])dnl
AC_REQUIRE([LTOBSOLETE_VERSION])dnl
m4_require([_LT_PROG_LTMAIN])dnl
_LT_SHELL_INIT([SHELL=${CONFIG_SHELL-/bin/sh}])
dnl Parse OPTIONS
_LT_SET_OPTIONS([$0], [$1])
# This can be used to rebuild libtool when needed
LIBTOOL_DEPS="$ltmain"
# Always use our own libtool.
LIBTOOL='$(SHELL) $(top_builddir)/libtool'
AC_SUBST(LIBTOOL)dnl
_LT_SETUP
# Only expand once:
m4_define([LT_INIT])
])# LT_INIT
# Old names:
AU_ALIAS([AC_PROG_LIBTOOL], [LT_INIT])
AU_ALIAS([AM_PROG_LIBTOOL], [LT_INIT])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_PROG_LIBTOOL], [])
dnl AC_DEFUN([AM_PROG_LIBTOOL], [])
# _LT_CC_BASENAME(CC)
# -------------------
# Calculate cc_basename. Skip known compiler wrappers and cross-prefix.
m4_defun([_LT_CC_BASENAME],
[for cc_temp in $1""; do
case $cc_temp in
compile | *[[\\/]]compile | ccache | *[[\\/]]ccache ) ;;
distcc | *[[\\/]]distcc | purify | *[[\\/]]purify ) ;;
\-*) ;;
*) break;;
esac
done
cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
])
# _LT_FILEUTILS_DEFAULTS
# ----------------------
# It is okay to use these file commands and assume they have been set
# sensibly after `m4_require([_LT_FILEUTILS_DEFAULTS])'.
m4_defun([_LT_FILEUTILS_DEFAULTS],
[: ${CP="cp -f"}
: ${MV="mv -f"}
: ${RM="rm -f"}
])# _LT_FILEUTILS_DEFAULTS
# _LT_SETUP
# ---------
m4_defun([_LT_SETUP],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
AC_REQUIRE([AC_CANONICAL_BUILD])dnl
AC_REQUIRE([_LT_PREPARE_SED_QUOTE_VARS])dnl
AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])dnl
_LT_DECL([], [PATH_SEPARATOR], [1], [The PATH separator for the build system])dnl
dnl
_LT_DECL([], [host_alias], [0], [The host system])dnl
_LT_DECL([], [host], [0])dnl
_LT_DECL([], [host_os], [0])dnl
dnl
_LT_DECL([], [build_alias], [0], [The build system])dnl
_LT_DECL([], [build], [0])dnl
_LT_DECL([], [build_os], [0])dnl
dnl
AC_REQUIRE([AC_PROG_CC])dnl
AC_REQUIRE([LT_PATH_LD])dnl
AC_REQUIRE([LT_PATH_NM])dnl
dnl
AC_REQUIRE([AC_PROG_LN_S])dnl
test -z "$LN_S" && LN_S="ln -s"
_LT_DECL([], [LN_S], [1], [Whether we need soft or hard links])dnl
dnl
AC_REQUIRE([LT_CMD_MAX_LEN])dnl
_LT_DECL([objext], [ac_objext], [0], [Object file suffix (normally "o")])dnl
_LT_DECL([], [exeext], [0], [Executable file suffix (normally "")])dnl
dnl
m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_CHECK_SHELL_FEATURES])dnl
m4_require([_LT_PATH_CONVERSION_FUNCTIONS])dnl
m4_require([_LT_CMD_RELOAD])dnl
m4_require([_LT_CHECK_MAGIC_METHOD])dnl
m4_require([_LT_CHECK_SHAREDLIB_FROM_LINKLIB])dnl
m4_require([_LT_CMD_OLD_ARCHIVE])dnl
m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
m4_require([_LT_WITH_SYSROOT])dnl
_LT_CONFIG_LIBTOOL_INIT([
# See if we are running on zsh, and set the options which allow our
# commands through without removal of \ escapes INIT.
if test -n "\${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
])
if test -n "${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
_LT_CHECK_OBJDIR
m4_require([_LT_TAG_COMPILER])dnl
case $host_os in
aix3*)
# AIX sometimes has problems with the GCC collect2 program. For some
# reason, if we set the COLLECT_NAMES environment variable, the problems
# vanish in a puff of smoke.
if test "X${COLLECT_NAMES+set}" != Xset; then
COLLECT_NAMES=
export COLLECT_NAMES
fi
;;
esac
# Global variables:
ofile=libtool
can_build_shared=yes
# All known linkers require a `.a' archive for static linking (except MSVC,
# which needs '.lib').
libext=a
with_gnu_ld="$lt_cv_prog_gnu_ld"
old_CC="$CC"
old_CFLAGS="$CFLAGS"
# Set sane defaults for various variables
test -z "$CC" && CC=cc
test -z "$LTCC" && LTCC=$CC
test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
test -z "$LD" && LD=ld
test -z "$ac_objext" && ac_objext=o
_LT_CC_BASENAME([$compiler])
# Only perform the check for file, if the check method requires it
test -z "$MAGIC_CMD" && MAGIC_CMD=file
case $deplibs_check_method in
file_magic*)
if test "$file_magic_cmd" = '$MAGIC_CMD'; then
_LT_PATH_MAGIC
fi
;;
esac
# Use C for the default configuration in the libtool script
LT_SUPPORTED_TAG([CC])
_LT_LANG_C_CONFIG
_LT_LANG_DEFAULT_CONFIG
_LT_CONFIG_COMMANDS
])# _LT_SETUP
# _LT_PREPARE_SED_QUOTE_VARS
# --------------------------
# Define a few sed substitution that help us do robust quoting.
m4_defun([_LT_PREPARE_SED_QUOTE_VARS],
[# Backslashify metacharacters that are still active within
# double-quoted strings.
sed_quote_subst='s/\([["`$\\]]\)/\\\1/g'
# Same as above, but do not quote variable references.
double_quote_subst='s/\([["`\\]]\)/\\\1/g'
# Sed substitution to delay expansion of an escaped shell variable in a
# double_quote_subst'ed string.
delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
# Sed substitution to delay expansion of an escaped single quote.
delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
# Sed substitution to avoid accidental globbing in evaled expressions
no_glob_subst='s/\*/\\\*/g'
])
# _LT_PROG_LTMAIN
# ---------------
# Note that this code is called both from `configure', and `config.status'
# now that we use AC_CONFIG_COMMANDS to generate libtool. Notably,
# `config.status' has no value for ac_aux_dir unless we are using Automake,
# so we pass a copy along to make sure it has a sensible value anyway.
m4_defun([_LT_PROG_LTMAIN],
[m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([ltmain.sh])])dnl
_LT_CONFIG_LIBTOOL_INIT([ac_aux_dir='$ac_aux_dir'])
ltmain="$ac_aux_dir/ltmain.sh"
])# _LT_PROG_LTMAIN
## ------------------------------------- ##
## Accumulate code for creating libtool. ##
## ------------------------------------- ##
# So that we can recreate a full libtool script including additional
# tags, we accumulate the chunks of code to send to AC_CONFIG_COMMANDS
# in macros and then make a single call at the end using the `libtool'
# label.
# _LT_CONFIG_LIBTOOL_INIT([INIT-COMMANDS])
# ----------------------------------------
# Register INIT-COMMANDS to be passed to AC_CONFIG_COMMANDS later.
m4_define([_LT_CONFIG_LIBTOOL_INIT],
[m4_ifval([$1],
[m4_append([_LT_OUTPUT_LIBTOOL_INIT],
[$1
])])])
# Initialize.
m4_define([_LT_OUTPUT_LIBTOOL_INIT])
# _LT_CONFIG_LIBTOOL([COMMANDS])
# ------------------------------
# Register COMMANDS to be passed to AC_CONFIG_COMMANDS later.
m4_define([_LT_CONFIG_LIBTOOL],
[m4_ifval([$1],
[m4_append([_LT_OUTPUT_LIBTOOL_COMMANDS],
[$1
])])])
# Initialize.
m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS])
# _LT_CONFIG_SAVE_COMMANDS([COMMANDS], [INIT_COMMANDS])
# -----------------------------------------------------
m4_defun([_LT_CONFIG_SAVE_COMMANDS],
[_LT_CONFIG_LIBTOOL([$1])
_LT_CONFIG_LIBTOOL_INIT([$2])
])
# _LT_FORMAT_COMMENT([COMMENT])
# -----------------------------
# Add leading comment marks to the start of each line, and a trailing
# full-stop to the whole comment if one is not present already.
m4_define([_LT_FORMAT_COMMENT],
[m4_ifval([$1], [
m4_bpatsubst([m4_bpatsubst([$1], [^ *], [# ])],
[['`$\]], [\\\&])]m4_bmatch([$1], [[!?.]$], [], [.])
)])
## ------------------------ ##
## FIXME: Eliminate VARNAME ##
## ------------------------ ##
# _LT_DECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION], [IS-TAGGED?])
# -------------------------------------------------------------------
# CONFIGNAME is the name given to the value in the libtool script.
# VARNAME is the (base) name used in the configure script.
# VALUE may be 0, 1 or 2 for a computed quote escaped value based on
# VARNAME. Any other value will be used directly.
m4_define([_LT_DECL],
[lt_if_append_uniq([lt_decl_varnames], [$2], [, ],
[lt_dict_add_subkey([lt_decl_dict], [$2], [libtool_name],
[m4_ifval([$1], [$1], [$2])])
lt_dict_add_subkey([lt_decl_dict], [$2], [value], [$3])
m4_ifval([$4],
[lt_dict_add_subkey([lt_decl_dict], [$2], [description], [$4])])
lt_dict_add_subkey([lt_decl_dict], [$2],
[tagged?], [m4_ifval([$5], [yes], [no])])])
])
# _LT_TAGDECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION])
# --------------------------------------------------------
m4_define([_LT_TAGDECL], [_LT_DECL([$1], [$2], [$3], [$4], [yes])])
# lt_decl_tag_varnames([SEPARATOR], [VARNAME1...])
# ------------------------------------------------
m4_define([lt_decl_tag_varnames],
[_lt_decl_filter([tagged?], [yes], $@)])
# _lt_decl_filter(SUBKEY, VALUE, [SEPARATOR], [VARNAME1..])
# ---------------------------------------------------------
m4_define([_lt_decl_filter],
[m4_case([$#],
[0], [m4_fatal([$0: too few arguments: $#])],
[1], [m4_fatal([$0: too few arguments: $#: $1])],
[2], [lt_dict_filter([lt_decl_dict], [$1], [$2], [], lt_decl_varnames)],
[3], [lt_dict_filter([lt_decl_dict], [$1], [$2], [$3], lt_decl_varnames)],
[lt_dict_filter([lt_decl_dict], $@)])[]dnl
])
# lt_decl_quote_varnames([SEPARATOR], [VARNAME1...])
# --------------------------------------------------
m4_define([lt_decl_quote_varnames],
[_lt_decl_filter([value], [1], $@)])
# lt_decl_dquote_varnames([SEPARATOR], [VARNAME1...])
# ---------------------------------------------------
m4_define([lt_decl_dquote_varnames],
[_lt_decl_filter([value], [2], $@)])
# lt_decl_varnames_tagged([SEPARATOR], [VARNAME1...])
# ---------------------------------------------------
m4_define([lt_decl_varnames_tagged],
[m4_assert([$# <= 2])dnl
_$0(m4_quote(m4_default([$1], [[, ]])),
m4_ifval([$2], [[$2]], [m4_dquote(lt_decl_tag_varnames)]),
m4_split(m4_normalize(m4_quote(_LT_TAGS)), [ ]))])
m4_define([_lt_decl_varnames_tagged],
[m4_ifval([$3], [lt_combine([$1], [$2], [_], $3)])])
# lt_decl_all_varnames([SEPARATOR], [VARNAME1...])
# ------------------------------------------------
m4_define([lt_decl_all_varnames],
[_$0(m4_quote(m4_default([$1], [[, ]])),
m4_if([$2], [],
m4_quote(lt_decl_varnames),
m4_quote(m4_shift($@))))[]dnl
])
m4_define([_lt_decl_all_varnames],
[lt_join($@, lt_decl_varnames_tagged([$1],
lt_decl_tag_varnames([[, ]], m4_shift($@))))dnl
])
# _LT_CONFIG_STATUS_DECLARE([VARNAME])
# ------------------------------------
# Quote a variable value, and forward it to `config.status' so that its
# declaration there will have the same value as in `configure'. VARNAME
# must have a single quote delimited value for this to work.
m4_define([_LT_CONFIG_STATUS_DECLARE],
[$1='`$ECHO "$][$1" | $SED "$delay_single_quote_subst"`'])
# _LT_CONFIG_STATUS_DECLARATIONS
# ------------------------------
# We delimit libtool config variables with single quotes, so when
# we write them to config.status, we have to be sure to quote all
# embedded single quotes properly. In configure, this macro expands
# each variable declared with _LT_DECL (and _LT_TAGDECL) into:
#
# ='`$ECHO "$" | $SED "$delay_single_quote_subst"`'
m4_defun([_LT_CONFIG_STATUS_DECLARATIONS],
[m4_foreach([_lt_var], m4_quote(lt_decl_all_varnames),
[m4_n([_LT_CONFIG_STATUS_DECLARE(_lt_var)])])])
# _LT_LIBTOOL_TAGS
# ----------------
# Output comment and list of tags supported by the script
m4_defun([_LT_LIBTOOL_TAGS],
[_LT_FORMAT_COMMENT([The names of the tagged configurations supported by this script])dnl
available_tags="_LT_TAGS"dnl
])
# _LT_LIBTOOL_DECLARE(VARNAME, [TAG])
# -----------------------------------
# Extract the dictionary values for VARNAME (optionally with TAG) and
# expand to a commented shell variable setting:
#
# # Some comment about what VAR is for.
# visible_name=$lt_internal_name
m4_define([_LT_LIBTOOL_DECLARE],
[_LT_FORMAT_COMMENT(m4_quote(lt_dict_fetch([lt_decl_dict], [$1],
[description])))[]dnl
m4_pushdef([_libtool_name],
m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [libtool_name])))[]dnl
m4_case(m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [value])),
[0], [_libtool_name=[$]$1],
[1], [_libtool_name=$lt_[]$1],
[2], [_libtool_name=$lt_[]$1],
[_libtool_name=lt_dict_fetch([lt_decl_dict], [$1], [value])])[]dnl
m4_ifval([$2], [_$2])[]m4_popdef([_libtool_name])[]dnl
])
# _LT_LIBTOOL_CONFIG_VARS
# -----------------------
# Produce commented declarations of non-tagged libtool config variables
# suitable for insertion in the LIBTOOL CONFIG section of the `libtool'
# script. Tagged libtool config variables (even for the LIBTOOL CONFIG
# section) are produced by _LT_LIBTOOL_TAG_VARS.
m4_defun([_LT_LIBTOOL_CONFIG_VARS],
[m4_foreach([_lt_var],
m4_quote(_lt_decl_filter([tagged?], [no], [], lt_decl_varnames)),
[m4_n([_LT_LIBTOOL_DECLARE(_lt_var)])])])
# _LT_LIBTOOL_TAG_VARS(TAG)
# -------------------------
m4_define([_LT_LIBTOOL_TAG_VARS],
[m4_foreach([_lt_var], m4_quote(lt_decl_tag_varnames),
[m4_n([_LT_LIBTOOL_DECLARE(_lt_var, [$1])])])])
# _LT_TAGVAR(VARNAME, [TAGNAME])
# ------------------------------
m4_define([_LT_TAGVAR], [m4_ifval([$2], [$1_$2], [$1])])
# _LT_CONFIG_COMMANDS
# -------------------
# Send accumulated output to $CONFIG_STATUS. Thanks to the lists of
# variables for single and double quote escaping we saved from calls
# to _LT_DECL, we can put quote escaped variables declarations
# into `config.status', and then the shell code to quote escape them in
# for loops in `config.status'. Finally, any additional code accumulated
# from calls to _LT_CONFIG_LIBTOOL_INIT is expanded.
m4_defun([_LT_CONFIG_COMMANDS],
[AC_PROVIDE_IFELSE([LT_OUTPUT],
dnl If the libtool generation code has been placed in $CONFIG_LT,
dnl instead of duplicating it all over again into config.status,
dnl then we will have config.status run $CONFIG_LT later, so it
dnl needs to know what name is stored there:
[AC_CONFIG_COMMANDS([libtool],
[$SHELL $CONFIG_LT || AS_EXIT(1)], [CONFIG_LT='$CONFIG_LT'])],
dnl If the libtool generation code is destined for config.status,
dnl expand the accumulated commands and init code now:
[AC_CONFIG_COMMANDS([libtool],
[_LT_OUTPUT_LIBTOOL_COMMANDS], [_LT_OUTPUT_LIBTOOL_COMMANDS_INIT])])
])#_LT_CONFIG_COMMANDS
# Initialize.
m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS_INIT],
[
# The HP-UX ksh and POSIX shell print the target directory to stdout
# if CDPATH is set.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
sed_quote_subst='$sed_quote_subst'
double_quote_subst='$double_quote_subst'
delay_variable_subst='$delay_variable_subst'
_LT_CONFIG_STATUS_DECLARATIONS
LTCC='$LTCC'
LTCFLAGS='$LTCFLAGS'
compiler='$compiler_DEFAULT'
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
\$[]1
_LTECHO_EOF'
}
# Quote evaled strings.
for var in lt_decl_all_varnames([[ \
]], lt_decl_quote_varnames); do
case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
*[[\\\\\\\`\\"\\\$]]*)
eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\""
;;
*)
eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
;;
esac
done
# Double-quote double-evaled strings.
for var in lt_decl_all_varnames([[ \
]], lt_decl_dquote_varnames); do
case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
*[[\\\\\\\`\\"\\\$]]*)
eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\""
;;
*)
eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
;;
esac
done
_LT_OUTPUT_LIBTOOL_INIT
])
# _LT_GENERATED_FILE_INIT(FILE, [COMMENT])
# ------------------------------------
# Generate a child script FILE with all initialization necessary to
# reuse the environment learned by the parent script, and make the
# file executable. If COMMENT is supplied, it is inserted after the
# `#!' sequence but before initialization text begins. After this
# macro, additional text can be appended to FILE to form the body of
# the child script. The macro ends with non-zero status if the
# file could not be fully written (such as if the disk is full).
m4_ifdef([AS_INIT_GENERATED],
[m4_defun([_LT_GENERATED_FILE_INIT],[AS_INIT_GENERATED($@)])],
[m4_defun([_LT_GENERATED_FILE_INIT],
[m4_require([AS_PREPARE])]dnl
[m4_pushdef([AS_MESSAGE_LOG_FD])]dnl
[lt_write_fail=0
cat >$1 <<_ASEOF || lt_write_fail=1
#! $SHELL
# Generated by $as_me.
$2
SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$1 <<\_ASEOF || lt_write_fail=1
AS_SHELL_SANITIZE
_AS_PREPARE
exec AS_MESSAGE_FD>&1
_ASEOF
test $lt_write_fail = 0 && chmod +x $1[]dnl
m4_popdef([AS_MESSAGE_LOG_FD])])])# _LT_GENERATED_FILE_INIT
# LT_OUTPUT
# ---------
# This macro allows early generation of the libtool script (before
# AC_OUTPUT is called), incase it is used in configure for compilation
# tests.
AC_DEFUN([LT_OUTPUT],
[: ${CONFIG_LT=./config.lt}
AC_MSG_NOTICE([creating $CONFIG_LT])
_LT_GENERATED_FILE_INIT(["$CONFIG_LT"],
[# Run this file to recreate a libtool stub with the current configuration.])
cat >>"$CONFIG_LT" <<\_LTEOF
lt_cl_silent=false
exec AS_MESSAGE_LOG_FD>>config.log
{
echo
AS_BOX([Running $as_me.])
} >&AS_MESSAGE_LOG_FD
lt_cl_help="\
\`$as_me' creates a local libtool stub from the current configuration,
for use in further configure time tests before the real libtool is
generated.
Usage: $[0] [[OPTIONS]]
-h, --help print this help, then exit
-V, --version print version number, then exit
-q, --quiet do not print progress messages
-d, --debug don't remove temporary files
Report bugs to ."
lt_cl_version="\
m4_ifset([AC_PACKAGE_NAME], [AC_PACKAGE_NAME ])config.lt[]dnl
m4_ifset([AC_PACKAGE_VERSION], [ AC_PACKAGE_VERSION])
configured by $[0], generated by m4_PACKAGE_STRING.
Copyright (C) 2011 Free Software Foundation, Inc.
This config.lt script is free software; the Free Software Foundation
gives unlimited permision to copy, distribute and modify it."
while test $[#] != 0
do
case $[1] in
--version | --v* | -V )
echo "$lt_cl_version"; exit 0 ;;
--help | --h* | -h )
echo "$lt_cl_help"; exit 0 ;;
--debug | --d* | -d )
debug=: ;;
--quiet | --q* | --silent | --s* | -q )
lt_cl_silent=: ;;
-*) AC_MSG_ERROR([unrecognized option: $[1]
Try \`$[0] --help' for more information.]) ;;
*) AC_MSG_ERROR([unrecognized argument: $[1]
Try \`$[0] --help' for more information.]) ;;
esac
shift
done
if $lt_cl_silent; then
exec AS_MESSAGE_FD>/dev/null
fi
_LTEOF
cat >>"$CONFIG_LT" <<_LTEOF
_LT_OUTPUT_LIBTOOL_COMMANDS_INIT
_LTEOF
cat >>"$CONFIG_LT" <<\_LTEOF
AC_MSG_NOTICE([creating $ofile])
_LT_OUTPUT_LIBTOOL_COMMANDS
AS_EXIT(0)
_LTEOF
chmod +x "$CONFIG_LT"
# configure is writing to config.log, but config.lt does its own redirection,
# appending to config.log, which fails on DOS, as config.log is still kept
# open by configure. Here we exec the FD to /dev/null, effectively closing
# config.log, so it can be properly (re)opened and appended to by config.lt.
lt_cl_success=:
test "$silent" = yes &&
lt_config_lt_args="$lt_config_lt_args --quiet"
exec AS_MESSAGE_LOG_FD>/dev/null
$SHELL "$CONFIG_LT" $lt_config_lt_args || lt_cl_success=false
exec AS_MESSAGE_LOG_FD>>config.log
$lt_cl_success || AS_EXIT(1)
])# LT_OUTPUT
# _LT_CONFIG(TAG)
# ---------------
# If TAG is the built-in tag, create an initial libtool script with a
# default configuration from the untagged config vars. Otherwise add code
# to config.status for appending the configuration named by TAG from the
# matching tagged config vars.
m4_defun([_LT_CONFIG],
[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
_LT_CONFIG_SAVE_COMMANDS([
m4_define([_LT_TAG], m4_if([$1], [], [C], [$1]))dnl
m4_if(_LT_TAG, [C], [
# See if we are running on zsh, and set the options which allow our
# commands through without removal of \ escapes.
if test -n "${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
cfgfile="${ofile}T"
trap "$RM \"$cfgfile\"; exit 1" 1 2 15
$RM "$cfgfile"
cat <<_LT_EOF >> "$cfgfile"
#! $SHELL
# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION
# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
# NOTE: Changes made to this file will be lost: look at ltmain.sh.
#
_LT_COPYING
_LT_LIBTOOL_TAGS
# ### BEGIN LIBTOOL CONFIG
_LT_LIBTOOL_CONFIG_VARS
_LT_LIBTOOL_TAG_VARS
# ### END LIBTOOL CONFIG
_LT_EOF
case $host_os in
aix3*)
cat <<\_LT_EOF >> "$cfgfile"
# AIX sometimes has problems with the GCC collect2 program. For some
# reason, if we set the COLLECT_NAMES environment variable, the problems
# vanish in a puff of smoke.
if test "X${COLLECT_NAMES+set}" != Xset; then
COLLECT_NAMES=
export COLLECT_NAMES
fi
_LT_EOF
;;
esac
_LT_PROG_LTMAIN
# We use sed instead of cat because bash on DJGPP gets confused if
# if finds mixed CR/LF and LF-only lines. Since sed operates in
# text mode, it properly converts lines to CR/LF. This bash problem
# is reportedly fixed, but why not run on old versions too?
sed '$q' "$ltmain" >> "$cfgfile" \
|| (rm -f "$cfgfile"; exit 1)
_LT_PROG_REPLACE_SHELLFNS
mv -f "$cfgfile" "$ofile" ||
(rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
chmod +x "$ofile"
],
[cat <<_LT_EOF >> "$ofile"
dnl Unfortunately we have to use $1 here, since _LT_TAG is not expanded
dnl in a comment (ie after a #).
# ### BEGIN LIBTOOL TAG CONFIG: $1
_LT_LIBTOOL_TAG_VARS(_LT_TAG)
# ### END LIBTOOL TAG CONFIG: $1
_LT_EOF
])dnl /m4_if
],
[m4_if([$1], [], [
PACKAGE='$PACKAGE'
VERSION='$VERSION'
TIMESTAMP='$TIMESTAMP'
RM='$RM'
ofile='$ofile'], [])
])dnl /_LT_CONFIG_SAVE_COMMANDS
])# _LT_CONFIG
# LT_SUPPORTED_TAG(TAG)
# ---------------------
# Trace this macro to discover what tags are supported by the libtool
# --tag option, using:
# autoconf --trace 'LT_SUPPORTED_TAG:$1'
AC_DEFUN([LT_SUPPORTED_TAG], [])
# C support is built-in for now
m4_define([_LT_LANG_C_enabled], [])
m4_define([_LT_TAGS], [])
# LT_LANG(LANG)
# -------------
# Enable libtool support for the given language if not already enabled.
AC_DEFUN([LT_LANG],
[AC_BEFORE([$0], [LT_OUTPUT])dnl
m4_case([$1],
[C], [_LT_LANG(C)],
[C++], [_LT_LANG(CXX)],
[Go], [_LT_LANG(GO)],
[Java], [_LT_LANG(GCJ)],
[Fortran 77], [_LT_LANG(F77)],
[Fortran], [_LT_LANG(FC)],
[Windows Resource], [_LT_LANG(RC)],
[m4_ifdef([_LT_LANG_]$1[_CONFIG],
[_LT_LANG($1)],
[m4_fatal([$0: unsupported language: "$1"])])])dnl
])# LT_LANG
# _LT_LANG(LANGNAME)
# ------------------
m4_defun([_LT_LANG],
[m4_ifdef([_LT_LANG_]$1[_enabled], [],
[LT_SUPPORTED_TAG([$1])dnl
m4_append([_LT_TAGS], [$1 ])dnl
m4_define([_LT_LANG_]$1[_enabled], [])dnl
_LT_LANG_$1_CONFIG($1)])dnl
])# _LT_LANG
m4_ifndef([AC_PROG_GO], [
############################################################
# NOTE: This macro has been submitted for inclusion into #
# GNU Autoconf as AC_PROG_GO. When it is available in #
# a released version of Autoconf we should remove this #
# macro and use it instead. #
############################################################
m4_defun([AC_PROG_GO],
[AC_LANG_PUSH(Go)dnl
AC_ARG_VAR([GOC], [Go compiler command])dnl
AC_ARG_VAR([GOFLAGS], [Go compiler flags])dnl
_AC_ARG_VAR_LDFLAGS()dnl
AC_CHECK_TOOL(GOC, gccgo)
if test -z "$GOC"; then
if test -n "$ac_tool_prefix"; then
AC_CHECK_PROG(GOC, [${ac_tool_prefix}gccgo], [${ac_tool_prefix}gccgo])
fi
fi
if test -z "$GOC"; then
AC_CHECK_PROG(GOC, gccgo, gccgo, false)
fi
])#m4_defun
])#m4_ifndef
# _LT_LANG_DEFAULT_CONFIG
# -----------------------
m4_defun([_LT_LANG_DEFAULT_CONFIG],
[AC_PROVIDE_IFELSE([AC_PROG_CXX],
[LT_LANG(CXX)],
[m4_define([AC_PROG_CXX], defn([AC_PROG_CXX])[LT_LANG(CXX)])])
AC_PROVIDE_IFELSE([AC_PROG_F77],
[LT_LANG(F77)],
[m4_define([AC_PROG_F77], defn([AC_PROG_F77])[LT_LANG(F77)])])
AC_PROVIDE_IFELSE([AC_PROG_FC],
[LT_LANG(FC)],
[m4_define([AC_PROG_FC], defn([AC_PROG_FC])[LT_LANG(FC)])])
dnl The call to [A][M_PROG_GCJ] is quoted like that to stop aclocal
dnl pulling things in needlessly.
AC_PROVIDE_IFELSE([AC_PROG_GCJ],
[LT_LANG(GCJ)],
[AC_PROVIDE_IFELSE([A][M_PROG_GCJ],
[LT_LANG(GCJ)],
[AC_PROVIDE_IFELSE([LT_PROG_GCJ],
[LT_LANG(GCJ)],
[m4_ifdef([AC_PROG_GCJ],
[m4_define([AC_PROG_GCJ], defn([AC_PROG_GCJ])[LT_LANG(GCJ)])])
m4_ifdef([A][M_PROG_GCJ],
[m4_define([A][M_PROG_GCJ], defn([A][M_PROG_GCJ])[LT_LANG(GCJ)])])
m4_ifdef([LT_PROG_GCJ],
[m4_define([LT_PROG_GCJ], defn([LT_PROG_GCJ])[LT_LANG(GCJ)])])])])])
AC_PROVIDE_IFELSE([AC_PROG_GO],
[LT_LANG(GO)],
[m4_define([AC_PROG_GO], defn([AC_PROG_GO])[LT_LANG(GO)])])
AC_PROVIDE_IFELSE([LT_PROG_RC],
[LT_LANG(RC)],
[m4_define([LT_PROG_RC], defn([LT_PROG_RC])[LT_LANG(RC)])])
])# _LT_LANG_DEFAULT_CONFIG
# Obsolete macros:
AU_DEFUN([AC_LIBTOOL_CXX], [LT_LANG(C++)])
AU_DEFUN([AC_LIBTOOL_F77], [LT_LANG(Fortran 77)])
AU_DEFUN([AC_LIBTOOL_FC], [LT_LANG(Fortran)])
AU_DEFUN([AC_LIBTOOL_GCJ], [LT_LANG(Java)])
AU_DEFUN([AC_LIBTOOL_RC], [LT_LANG(Windows Resource)])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_CXX], [])
dnl AC_DEFUN([AC_LIBTOOL_F77], [])
dnl AC_DEFUN([AC_LIBTOOL_FC], [])
dnl AC_DEFUN([AC_LIBTOOL_GCJ], [])
dnl AC_DEFUN([AC_LIBTOOL_RC], [])
# _LT_TAG_COMPILER
# ----------------
m4_defun([_LT_TAG_COMPILER],
[AC_REQUIRE([AC_PROG_CC])dnl
_LT_DECL([LTCC], [CC], [1], [A C compiler])dnl
_LT_DECL([LTCFLAGS], [CFLAGS], [1], [LTCC compiler flags])dnl
_LT_TAGDECL([CC], [compiler], [1], [A language specific compiler])dnl
_LT_TAGDECL([with_gcc], [GCC], [0], [Is the compiler the GNU compiler?])dnl
# If no C compiler was specified, use CC.
LTCC=${LTCC-"$CC"}
# If no C compiler flags were specified, use CFLAGS.
LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
# Allow CC to be a program name with arguments.
compiler=$CC
])# _LT_TAG_COMPILER
# _LT_COMPILER_BOILERPLATE
# ------------------------
# Check for compiler boilerplate output or warnings with
# the simple compiler test code.
m4_defun([_LT_COMPILER_BOILERPLATE],
[m4_require([_LT_DECL_SED])dnl
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" >conftest.$ac_ext
eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_compiler_boilerplate=`cat conftest.err`
$RM conftest*
])# _LT_COMPILER_BOILERPLATE
# _LT_LINKER_BOILERPLATE
# ----------------------
# Check for linker boilerplate output or warnings with
# the simple link test code.
m4_defun([_LT_LINKER_BOILERPLATE],
[m4_require([_LT_DECL_SED])dnl
ac_outfile=conftest.$ac_objext
echo "$lt_simple_link_test_code" >conftest.$ac_ext
eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_linker_boilerplate=`cat conftest.err`
$RM -r conftest*
])# _LT_LINKER_BOILERPLATE
# _LT_REQUIRED_DARWIN_CHECKS
# -------------------------
m4_defun_once([_LT_REQUIRED_DARWIN_CHECKS],[
case $host_os in
rhapsody* | darwin*)
AC_CHECK_TOOL([DSYMUTIL], [dsymutil], [:])
AC_CHECK_TOOL([NMEDIT], [nmedit], [:])
AC_CHECK_TOOL([LIPO], [lipo], [:])
AC_CHECK_TOOL([OTOOL], [otool], [:])
AC_CHECK_TOOL([OTOOL64], [otool64], [:])
_LT_DECL([], [DSYMUTIL], [1],
[Tool to manipulate archived DWARF debug symbol files on Mac OS X])
_LT_DECL([], [NMEDIT], [1],
[Tool to change global to local symbols on Mac OS X])
_LT_DECL([], [LIPO], [1],
[Tool to manipulate fat objects and archives on Mac OS X])
_LT_DECL([], [OTOOL], [1],
[ldd/readelf like tool for Mach-O binaries on Mac OS X])
_LT_DECL([], [OTOOL64], [1],
[ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4])
AC_CACHE_CHECK([for -single_module linker flag],[lt_cv_apple_cc_single_mod],
[lt_cv_apple_cc_single_mod=no
if test -z "${LT_MULTI_MODULE}"; then
# By default we will add the -single_module flag. You can override
# by either setting the environment variable LT_MULTI_MODULE
# non-empty at configure time, or by adding -multi_module to the
# link flags.
rm -rf libconftest.dylib*
echo "int foo(void){return 1;}" > conftest.c
echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
-dynamiclib -Wl,-single_module conftest.c" >&AS_MESSAGE_LOG_FD
$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
-dynamiclib -Wl,-single_module conftest.c 2>conftest.err
_lt_result=$?
# If there is a non-empty error log, and "single_module"
# appears in it, assume the flag caused a linker warning
if test -s conftest.err && $GREP single_module conftest.err; then
cat conftest.err >&AS_MESSAGE_LOG_FD
# Otherwise, if the output was created with a 0 exit code from
# the compiler, it worked.
elif test -f libconftest.dylib && test $_lt_result -eq 0; then
lt_cv_apple_cc_single_mod=yes
else
cat conftest.err >&AS_MESSAGE_LOG_FD
fi
rm -rf libconftest.dylib*
rm -f conftest.*
fi])
AC_CACHE_CHECK([for -exported_symbols_list linker flag],
[lt_cv_ld_exported_symbols_list],
[lt_cv_ld_exported_symbols_list=no
save_LDFLAGS=$LDFLAGS
echo "_main" > conftest.sym
LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
[lt_cv_ld_exported_symbols_list=yes],
[lt_cv_ld_exported_symbols_list=no])
LDFLAGS="$save_LDFLAGS"
])
AC_CACHE_CHECK([for -force_load linker flag],[lt_cv_ld_force_load],
[lt_cv_ld_force_load=no
cat > conftest.c << _LT_EOF
int forced_loaded() { return 2;}
_LT_EOF
echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&AS_MESSAGE_LOG_FD
$LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&AS_MESSAGE_LOG_FD
echo "$AR cru libconftest.a conftest.o" >&AS_MESSAGE_LOG_FD
$AR cru libconftest.a conftest.o 2>&AS_MESSAGE_LOG_FD
echo "$RANLIB libconftest.a" >&AS_MESSAGE_LOG_FD
$RANLIB libconftest.a 2>&AS_MESSAGE_LOG_FD
cat > conftest.c << _LT_EOF
int main() { return 0;}
_LT_EOF
echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&AS_MESSAGE_LOG_FD
$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err
_lt_result=$?
if test -s conftest.err && $GREP force_load conftest.err; then
cat conftest.err >&AS_MESSAGE_LOG_FD
elif test -f conftest && test $_lt_result -eq 0 && $GREP forced_load conftest >/dev/null 2>&1 ; then
lt_cv_ld_force_load=yes
else
cat conftest.err >&AS_MESSAGE_LOG_FD
fi
rm -f conftest.err libconftest.a conftest conftest.c
rm -rf conftest.dSYM
])
case $host_os in
rhapsody* | darwin1.[[012]])
_lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;;
darwin1.*)
_lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
darwin*) # darwin 5.x on
# if running on 10.5 or later, the deployment target defaults
# to the OS version, if on x86, and 10.4, the deployment
# target defaults to 10.4. Don't you love it?
case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in
10.0,*86*-darwin8*|10.0,*-darwin[[91]]*)
_lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
10.[[012]]*)
_lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
10.*)
_lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
esac
;;
esac
if test "$lt_cv_apple_cc_single_mod" = "yes"; then
_lt_dar_single_mod='$single_module'
fi
if test "$lt_cv_ld_exported_symbols_list" = "yes"; then
_lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym'
else
_lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}'
fi
if test "$DSYMUTIL" != ":" && test "$lt_cv_ld_force_load" = "no"; then
_lt_dsymutil='~$DSYMUTIL $lib || :'
else
_lt_dsymutil=
fi
;;
esac
])
# _LT_DARWIN_LINKER_FEATURES([TAG])
# ---------------------------------
# Checks for linker and compiler features on darwin
m4_defun([_LT_DARWIN_LINKER_FEATURES],
[
m4_require([_LT_REQUIRED_DARWIN_CHECKS])
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_automatic, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
if test "$lt_cv_ld_force_load" = "yes"; then
_LT_TAGVAR(whole_archive_flag_spec, $1)='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
m4_case([$1], [F77], [_LT_TAGVAR(compiler_needs_object, $1)=yes],
[FC], [_LT_TAGVAR(compiler_needs_object, $1)=yes])
else
_LT_TAGVAR(whole_archive_flag_spec, $1)=''
fi
_LT_TAGVAR(link_all_deplibs, $1)=yes
_LT_TAGVAR(allow_undefined_flag, $1)="$_lt_dar_allow_undefined"
case $cc_basename in
ifort*) _lt_dar_can_shared=yes ;;
*) _lt_dar_can_shared=$GCC ;;
esac
if test "$_lt_dar_can_shared" = "yes"; then
output_verbose_link_cmd=func_echo_all
_LT_TAGVAR(archive_cmds, $1)="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
_LT_TAGVAR(module_cmds, $1)="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
_LT_TAGVAR(archive_expsym_cmds, $1)="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
_LT_TAGVAR(module_expsym_cmds, $1)="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
m4_if([$1], [CXX],
[ if test "$lt_cv_apple_cc_single_mod" != "yes"; then
_LT_TAGVAR(archive_cmds, $1)="\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dsymutil}"
_LT_TAGVAR(archive_expsym_cmds, $1)="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \${lib}-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \${lib}-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring${_lt_dar_export_syms}${_lt_dsymutil}"
fi
],[])
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
])
# _LT_SYS_MODULE_PATH_AIX([TAGNAME])
# ----------------------------------
# Links a minimal program and checks the executable
# for the system default hardcoded library path. In most cases,
# this is /usr/lib:/lib, but when the MPI compilers are used
# the location of the communication and MPI libs are included too.
# If we don't find anything, use the default library path according
# to the aix ld manual.
# Store the results from the different compilers for each TAGNAME.
# Allow to override them for all tags through lt_cv_aix_libpath.
m4_defun([_LT_SYS_MODULE_PATH_AIX],
[m4_require([_LT_DECL_SED])dnl
if test "${lt_cv_aix_libpath+set}" = set; then
aix_libpath=$lt_cv_aix_libpath
else
AC_CACHE_VAL([_LT_TAGVAR([lt_cv_aix_libpath_], [$1])],
[AC_LINK_IFELSE([AC_LANG_PROGRAM],[
lt_aix_libpath_sed='[
/Import File Strings/,/^$/ {
/^0/ {
s/^0 *\([^ ]*\) *$/\1/
p
}
}]'
_LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
# Check for a 64-bit object if we didn't find anything.
if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then
_LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
fi],[])
if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then
_LT_TAGVAR([lt_cv_aix_libpath_], [$1])="/usr/lib:/lib"
fi
])
aix_libpath=$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])
fi
])# _LT_SYS_MODULE_PATH_AIX
# _LT_SHELL_INIT(ARG)
# -------------------
m4_define([_LT_SHELL_INIT],
[m4_divert_text([M4SH-INIT], [$1
])])# _LT_SHELL_INIT
# _LT_PROG_ECHO_BACKSLASH
# -----------------------
# Find how we can fake an echo command that does not interpret backslash.
# In particular, with Autoconf 2.60 or later we add some code to the start
# of the generated configure script which will find a shell with a builtin
# printf (which we can use as an echo command).
m4_defun([_LT_PROG_ECHO_BACKSLASH],
[ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
AC_MSG_CHECKING([how to print strings])
# Test print first, because it will be a builtin if present.
if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \
test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then
ECHO='print -r --'
elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then
ECHO='printf %s\n'
else
# Use this function as a fallback that always works.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
$[]1
_LTECHO_EOF'
}
ECHO='func_fallback_echo'
fi
# func_echo_all arg...
# Invoke $ECHO with all args, space-separated.
func_echo_all ()
{
$ECHO "$*"
}
case "$ECHO" in
printf*) AC_MSG_RESULT([printf]) ;;
print*) AC_MSG_RESULT([print -r]) ;;
*) AC_MSG_RESULT([cat]) ;;
esac
m4_ifdef([_AS_DETECT_SUGGESTED],
[_AS_DETECT_SUGGESTED([
test -n "${ZSH_VERSION+set}${BASH_VERSION+set}" || (
ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
PATH=/empty FPATH=/empty; export PATH FPATH
test "X`printf %s $ECHO`" = "X$ECHO" \
|| test "X`print -r -- $ECHO`" = "X$ECHO" )])])
_LT_DECL([], [SHELL], [1], [Shell to use when invoking shell scripts])
_LT_DECL([], [ECHO], [1], [An echo program that protects backslashes])
])# _LT_PROG_ECHO_BACKSLASH
# _LT_WITH_SYSROOT
# ----------------
AC_DEFUN([_LT_WITH_SYSROOT],
[AC_MSG_CHECKING([for sysroot])
AC_ARG_WITH([sysroot],
[ --with-sysroot[=DIR] Search for dependent libraries within DIR
(or the compiler's sysroot if not specified).],
[], [with_sysroot=no])
dnl lt_sysroot will always be passed unquoted. We quote it here
dnl in case the user passed a directory name.
lt_sysroot=
case ${with_sysroot} in #(
yes)
if test "$GCC" = yes; then
lt_sysroot=`$CC --print-sysroot 2>/dev/null`
fi
;; #(
/*)
lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"`
;; #(
no|'')
;; #(
*)
AC_MSG_RESULT([${with_sysroot}])
AC_MSG_ERROR([The sysroot must be an absolute path.])
;;
esac
AC_MSG_RESULT([${lt_sysroot:-no}])
_LT_DECL([], [lt_sysroot], [0], [The root where to search for ]dnl
[dependent libraries, and in which our libraries should be installed.])])
# _LT_ENABLE_LOCK
# ---------------
m4_defun([_LT_ENABLE_LOCK],
[AC_ARG_ENABLE([libtool-lock],
[AS_HELP_STRING([--disable-libtool-lock],
[avoid locking (might break parallel builds)])])
test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
# Some flags need to be propagated to the compiler or linker for good
# libtool support.
case $host in
ia64-*-hpux*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if AC_TRY_EVAL(ac_compile); then
case `/usr/bin/file conftest.$ac_objext` in
*ELF-32*)
HPUX_IA64_MODE="32"
;;
*ELF-64*)
HPUX_IA64_MODE="64"
;;
esac
fi
rm -rf conftest*
;;
*-*-irix6*)
# Find out which ABI we are using.
echo '[#]line '$LINENO' "configure"' > conftest.$ac_ext
if AC_TRY_EVAL(ac_compile); then
if test "$lt_cv_prog_gnu_ld" = yes; then
case `/usr/bin/file conftest.$ac_objext` in
*32-bit*)
LD="${LD-ld} -melf32bsmip"
;;
*N32*)
LD="${LD-ld} -melf32bmipn32"
;;
*64-bit*)
LD="${LD-ld} -melf64bmip"
;;
esac
else
case `/usr/bin/file conftest.$ac_objext` in
*32-bit*)
LD="${LD-ld} -32"
;;
*N32*)
LD="${LD-ld} -n32"
;;
*64-bit*)
LD="${LD-ld} -64"
;;
esac
fi
fi
rm -rf conftest*
;;
x86_64-*kfreebsd*-gnu|x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*| \
s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if AC_TRY_EVAL(ac_compile); then
case `/usr/bin/file conftest.o` in
*32-bit*)
case $host in
x86_64-*kfreebsd*-gnu)
LD="${LD-ld} -m elf_i386_fbsd"
;;
x86_64-*linux*)
LD="${LD-ld} -m elf_i386"
;;
ppc64-*linux*|powerpc64-*linux*)
LD="${LD-ld} -m elf32ppclinux"
;;
s390x-*linux*)
LD="${LD-ld} -m elf_s390"
;;
sparc64-*linux*)
LD="${LD-ld} -m elf32_sparc"
;;
esac
;;
*64-bit*)
case $host in
x86_64-*kfreebsd*-gnu)
LD="${LD-ld} -m elf_x86_64_fbsd"
;;
x86_64-*linux*)
LD="${LD-ld} -m elf_x86_64"
;;
ppc*-*linux*|powerpc*-*linux*)
LD="${LD-ld} -m elf64ppc"
;;
s390*-*linux*|s390*-*tpf*)
LD="${LD-ld} -m elf64_s390"
;;
sparc*-*linux*)
LD="${LD-ld} -m elf64_sparc"
;;
esac
;;
esac
fi
rm -rf conftest*
;;
*-*-sco3.2v5*)
# On SCO OpenServer 5, we need -belf to get full-featured binaries.
SAVE_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -belf"
AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
[AC_LANG_PUSH(C)
AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],[[]])],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
AC_LANG_POP])
if test x"$lt_cv_cc_needs_belf" != x"yes"; then
# this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
CFLAGS="$SAVE_CFLAGS"
fi
;;
*-*solaris*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if AC_TRY_EVAL(ac_compile); then
case `/usr/bin/file conftest.o` in
*64-bit*)
case $lt_cv_prog_gnu_ld in
yes*)
case $host in
i?86-*-solaris*)
LD="${LD-ld} -m elf_x86_64"
;;
sparc*-*-solaris*)
LD="${LD-ld} -m elf64_sparc"
;;
esac
# GNU ld 2.21 introduced _sol2 emulations. Use them if available.
if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then
LD="${LD-ld}_sol2"
fi
;;
*)
if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
LD="${LD-ld} -64"
fi
;;
esac
;;
esac
fi
rm -rf conftest*
;;
esac
need_locks="$enable_libtool_lock"
])# _LT_ENABLE_LOCK
# _LT_PROG_AR
# -----------
m4_defun([_LT_PROG_AR],
[AC_CHECK_TOOLS(AR, [ar], false)
: ${AR=ar}
: ${AR_FLAGS=cru}
_LT_DECL([], [AR], [1], [The archiver])
_LT_DECL([], [AR_FLAGS], [1], [Flags to create an archive])
AC_CACHE_CHECK([for archiver @FILE support], [lt_cv_ar_at_file],
[lt_cv_ar_at_file=no
AC_COMPILE_IFELSE([AC_LANG_PROGRAM],
[echo conftest.$ac_objext > conftest.lst
lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&AS_MESSAGE_LOG_FD'
AC_TRY_EVAL([lt_ar_try])
if test "$ac_status" -eq 0; then
# Ensure the archiver fails upon bogus file names.
rm -f conftest.$ac_objext libconftest.a
AC_TRY_EVAL([lt_ar_try])
if test "$ac_status" -ne 0; then
lt_cv_ar_at_file=@
fi
fi
rm -f conftest.* libconftest.a
])
])
if test "x$lt_cv_ar_at_file" = xno; then
archiver_list_spec=
else
archiver_list_spec=$lt_cv_ar_at_file
fi
_LT_DECL([], [archiver_list_spec], [1],
[How to feed a file listing to the archiver])
])# _LT_PROG_AR
# _LT_CMD_OLD_ARCHIVE
# -------------------
m4_defun([_LT_CMD_OLD_ARCHIVE],
[_LT_PROG_AR
AC_CHECK_TOOL(STRIP, strip, :)
test -z "$STRIP" && STRIP=:
_LT_DECL([], [STRIP], [1], [A symbol stripping program])
AC_CHECK_TOOL(RANLIB, ranlib, :)
test -z "$RANLIB" && RANLIB=:
_LT_DECL([], [RANLIB], [1],
[Commands used to install an old-style archive])
# Determine commands to create old-style static archives.
old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
old_postinstall_cmds='chmod 644 $oldlib'
old_postuninstall_cmds=
if test -n "$RANLIB"; then
case $host_os in
openbsd*)
old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib"
;;
*)
old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib"
;;
esac
old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib"
fi
case $host_os in
darwin*)
lock_old_archive_extraction=yes ;;
*)
lock_old_archive_extraction=no ;;
esac
_LT_DECL([], [old_postinstall_cmds], [2])
_LT_DECL([], [old_postuninstall_cmds], [2])
_LT_TAGDECL([], [old_archive_cmds], [2],
[Commands used to build an old-style archive])
_LT_DECL([], [lock_old_archive_extraction], [0],
[Whether to use a lock for old archive extraction])
])# _LT_CMD_OLD_ARCHIVE
# _LT_COMPILER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
# [OUTPUT-FILE], [ACTION-SUCCESS], [ACTION-FAILURE])
# ----------------------------------------------------------------
# Check whether the given compiler option works
AC_DEFUN([_LT_COMPILER_OPTION],
[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_DECL_SED])dnl
AC_CACHE_CHECK([$1], [$2],
[$2=no
m4_if([$4], , [ac_outfile=conftest.$ac_objext], [ac_outfile=$4])
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="$3"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
# The option is referenced via a variable to avoid confusing sed.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&AS_MESSAGE_LOG_FD
echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
$2=yes
fi
fi
$RM conftest*
])
if test x"[$]$2" = xyes; then
m4_if([$5], , :, [$5])
else
m4_if([$6], , :, [$6])
fi
])# _LT_COMPILER_OPTION
# Old name:
AU_ALIAS([AC_LIBTOOL_COMPILER_OPTION], [_LT_COMPILER_OPTION])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_COMPILER_OPTION], [])
# _LT_LINKER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS,
# [ACTION-SUCCESS], [ACTION-FAILURE])
# ----------------------------------------------------
# Check whether the given linker option works
AC_DEFUN([_LT_LINKER_OPTION],
[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_DECL_SED])dnl
AC_CACHE_CHECK([$1], [$2],
[$2=no
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS $3"
echo "$lt_simple_link_test_code" > conftest.$ac_ext
if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
# The linker can only warn and ignore the option if not recognized
# So say no if there are warnings
if test -s conftest.err; then
# Append any errors to the config.log.
cat conftest.err 1>&AS_MESSAGE_LOG_FD
$ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if diff conftest.exp conftest.er2 >/dev/null; then
$2=yes
fi
else
$2=yes
fi
fi
$RM -r conftest*
LDFLAGS="$save_LDFLAGS"
])
if test x"[$]$2" = xyes; then
m4_if([$4], , :, [$4])
else
m4_if([$5], , :, [$5])
fi
])# _LT_LINKER_OPTION
# Old name:
AU_ALIAS([AC_LIBTOOL_LINKER_OPTION], [_LT_LINKER_OPTION])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_LINKER_OPTION], [])
# LT_CMD_MAX_LEN
#---------------
AC_DEFUN([LT_CMD_MAX_LEN],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
# find the maximum length of command line arguments
AC_MSG_CHECKING([the maximum length of command line arguments])
AC_CACHE_VAL([lt_cv_sys_max_cmd_len], [dnl
i=0
teststring="ABCD"
case $build_os in
msdosdjgpp*)
# On DJGPP, this test can blow up pretty badly due to problems in libc
# (any single argument exceeding 2000 bytes causes a buffer overrun
# during glob expansion). Even if it were fixed, the result of this
# check would be larger than it should be.
lt_cv_sys_max_cmd_len=12288; # 12K is about right
;;
gnu*)
# Under GNU Hurd, this test is not required because there is
# no limit to the length of command line arguments.
# Libtool will interpret -1 as no limit whatsoever
lt_cv_sys_max_cmd_len=-1;
;;
cygwin* | mingw* | cegcc*)
# On Win9x/ME, this test blows up -- it succeeds, but takes
# about 5 minutes as the teststring grows exponentially.
# Worse, since 9x/ME are not pre-emptively multitasking,
# you end up with a "frozen" computer, even though with patience
# the test eventually succeeds (with a max line length of 256k).
# Instead, let's just punt: use the minimum linelength reported by
# all of the supported platforms: 8192 (on NT/2K/XP).
lt_cv_sys_max_cmd_len=8192;
;;
mint*)
# On MiNT this can take a long time and run out of memory.
lt_cv_sys_max_cmd_len=8192;
;;
amigaos*)
# On AmigaOS with pdksh, this test takes hours, literally.
# So we just punt and use a minimum line length of 8192.
lt_cv_sys_max_cmd_len=8192;
;;
netbsd* | freebsd* | openbsd* | darwin* | dragonfly*)
# This has been around since 386BSD, at least. Likely further.
if test -x /sbin/sysctl; then
lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
elif test -x /usr/sbin/sysctl; then
lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
else
lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs
fi
# And add a safety zone
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
;;
interix*)
# We know the value 262144 and hardcode it with a safety zone (like BSD)
lt_cv_sys_max_cmd_len=196608
;;
os2*)
# The test takes a long time on OS/2.
lt_cv_sys_max_cmd_len=8192
;;
osf*)
# Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
# due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
# nice to cause kernel panics so lets avoid the loop below.
# First set a reasonable default.
lt_cv_sys_max_cmd_len=16384
#
if test -x /sbin/sysconfig; then
case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
*1*) lt_cv_sys_max_cmd_len=-1 ;;
esac
fi
;;
sco3.2v5*)
lt_cv_sys_max_cmd_len=102400
;;
sysv5* | sco5v6* | sysv4.2uw2*)
kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
if test -n "$kargmax"; then
lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[[ ]]//'`
else
lt_cv_sys_max_cmd_len=32768
fi
;;
*)
lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
if test -n "$lt_cv_sys_max_cmd_len"; then
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
else
# Make teststring a little bigger before we do anything with it.
# a 1K string should be a reasonable start.
for i in 1 2 3 4 5 6 7 8 ; do
teststring=$teststring$teststring
done
SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
# If test is not a shell built-in, we'll probably end up computing a
# maximum length that is only half of the actual maximum length, but
# we can't tell.
while { test "X"`env echo "$teststring$teststring" 2>/dev/null` \
= "X$teststring$teststring"; } >/dev/null 2>&1 &&
test $i != 17 # 1/2 MB should be enough
do
i=`expr $i + 1`
teststring=$teststring$teststring
done
# Only check the string length outside the loop.
lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
teststring=
# Add a significant safety factor because C++ compilers can tack on
# massive amounts of additional arguments before passing them to the
# linker. It appears as though 1/2 is a usable value.
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
fi
;;
esac
])
if test -n $lt_cv_sys_max_cmd_len ; then
AC_MSG_RESULT($lt_cv_sys_max_cmd_len)
else
AC_MSG_RESULT(none)
fi
max_cmd_len=$lt_cv_sys_max_cmd_len
_LT_DECL([], [max_cmd_len], [0],
[What is the maximum length of a command?])
])# LT_CMD_MAX_LEN
# Old name:
AU_ALIAS([AC_LIBTOOL_SYS_MAX_CMD_LEN], [LT_CMD_MAX_LEN])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_SYS_MAX_CMD_LEN], [])
# _LT_HEADER_DLFCN
# ----------------
m4_defun([_LT_HEADER_DLFCN],
[AC_CHECK_HEADERS([dlfcn.h], [], [], [AC_INCLUDES_DEFAULT])dnl
])# _LT_HEADER_DLFCN
# _LT_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE,
# ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING)
# ----------------------------------------------------------------
m4_defun([_LT_TRY_DLOPEN_SELF],
[m4_require([_LT_HEADER_DLFCN])dnl
if test "$cross_compiling" = yes; then :
[$4]
else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
[#line $LINENO "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
#include
#endif
#include
#ifdef RTLD_GLOBAL
# define LT_DLGLOBAL RTLD_GLOBAL
#else
# ifdef DL_GLOBAL
# define LT_DLGLOBAL DL_GLOBAL
# else
# define LT_DLGLOBAL 0
# endif
#endif
/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
find out it does not work in some platform. */
#ifndef LT_DLLAZY_OR_NOW
# ifdef RTLD_LAZY
# define LT_DLLAZY_OR_NOW RTLD_LAZY
# else
# ifdef DL_LAZY
# define LT_DLLAZY_OR_NOW DL_LAZY
# else
# ifdef RTLD_NOW
# define LT_DLLAZY_OR_NOW RTLD_NOW
# else
# ifdef DL_NOW
# define LT_DLLAZY_OR_NOW DL_NOW
# else
# define LT_DLLAZY_OR_NOW 0
# endif
# endif
# endif
# endif
#endif
/* When -fvisbility=hidden is used, assume the code has been annotated
correspondingly for the symbols needed. */
#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
int fnord () __attribute__((visibility("default")));
#endif
int fnord () { return 42; }
int main ()
{
void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
int status = $lt_dlunknown;
if (self)
{
if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
else
{
if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
else puts (dlerror ());
}
/* dlclose (self); */
}
else
puts (dlerror ());
return status;
}]
_LT_EOF
if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext} 2>/dev/null; then
(./conftest; exit; ) >&AS_MESSAGE_LOG_FD 2>/dev/null
lt_status=$?
case x$lt_status in
x$lt_dlno_uscore) $1 ;;
x$lt_dlneed_uscore) $2 ;;
x$lt_dlunknown|x*) $3 ;;
esac
else :
# compilation failed
$3
fi
fi
rm -fr conftest*
])# _LT_TRY_DLOPEN_SELF
# LT_SYS_DLOPEN_SELF
# ------------------
AC_DEFUN([LT_SYS_DLOPEN_SELF],
[m4_require([_LT_HEADER_DLFCN])dnl
if test "x$enable_dlopen" != xyes; then
enable_dlopen=unknown
enable_dlopen_self=unknown
enable_dlopen_self_static=unknown
else
lt_cv_dlopen=no
lt_cv_dlopen_libs=
case $host_os in
beos*)
lt_cv_dlopen="load_add_on"
lt_cv_dlopen_libs=
lt_cv_dlopen_self=yes
;;
mingw* | pw32* | cegcc*)
lt_cv_dlopen="LoadLibrary"
lt_cv_dlopen_libs=
;;
cygwin*)
lt_cv_dlopen="dlopen"
lt_cv_dlopen_libs=
;;
darwin*)
# if libdl is installed we need to link against it
AC_CHECK_LIB([dl], [dlopen],
[lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],[
lt_cv_dlopen="dyld"
lt_cv_dlopen_libs=
lt_cv_dlopen_self=yes
])
;;
*)
AC_CHECK_FUNC([shl_load],
[lt_cv_dlopen="shl_load"],
[AC_CHECK_LIB([dld], [shl_load],
[lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"],
[AC_CHECK_FUNC([dlopen],
[lt_cv_dlopen="dlopen"],
[AC_CHECK_LIB([dl], [dlopen],
[lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"],
[AC_CHECK_LIB([svld], [dlopen],
[lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"],
[AC_CHECK_LIB([dld], [dld_link],
[lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"])
])
])
])
])
])
;;
esac
if test "x$lt_cv_dlopen" != xno; then
enable_dlopen=yes
else
enable_dlopen=no
fi
case $lt_cv_dlopen in
dlopen)
save_CPPFLAGS="$CPPFLAGS"
test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
save_LDFLAGS="$LDFLAGS"
wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
save_LIBS="$LIBS"
LIBS="$lt_cv_dlopen_libs $LIBS"
AC_CACHE_CHECK([whether a program can dlopen itself],
lt_cv_dlopen_self, [dnl
_LT_TRY_DLOPEN_SELF(
lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes,
lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross)
])
if test "x$lt_cv_dlopen_self" = xyes; then
wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
AC_CACHE_CHECK([whether a statically linked program can dlopen itself],
lt_cv_dlopen_self_static, [dnl
_LT_TRY_DLOPEN_SELF(
lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes,
lt_cv_dlopen_self_static=no, lt_cv_dlopen_self_static=cross)
])
fi
CPPFLAGS="$save_CPPFLAGS"
LDFLAGS="$save_LDFLAGS"
LIBS="$save_LIBS"
;;
esac
case $lt_cv_dlopen_self in
yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
*) enable_dlopen_self=unknown ;;
esac
case $lt_cv_dlopen_self_static in
yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
*) enable_dlopen_self_static=unknown ;;
esac
fi
_LT_DECL([dlopen_support], [enable_dlopen], [0],
[Whether dlopen is supported])
_LT_DECL([dlopen_self], [enable_dlopen_self], [0],
[Whether dlopen of programs is supported])
_LT_DECL([dlopen_self_static], [enable_dlopen_self_static], [0],
[Whether dlopen of statically linked programs is supported])
])# LT_SYS_DLOPEN_SELF
# Old name:
AU_ALIAS([AC_LIBTOOL_DLOPEN_SELF], [LT_SYS_DLOPEN_SELF])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF], [])
# _LT_COMPILER_C_O([TAGNAME])
# ---------------------------
# Check to see if options -c and -o are simultaneously supported by compiler.
# This macro does not hard code the compiler like AC_PROG_CC_C_O.
m4_defun([_LT_COMPILER_C_O],
[m4_require([_LT_DECL_SED])dnl
m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_TAG_COMPILER])dnl
AC_CACHE_CHECK([if $compiler supports -c -o file.$ac_objext],
[_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)],
[_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=no
$RM -r conftest 2>/dev/null
mkdir conftest
cd conftest
mkdir out
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-o out/conftest2.$ac_objext"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&AS_MESSAGE_LOG_FD
echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
$SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
fi
fi
chmod u+w . 2>&AS_MESSAGE_LOG_FD
$RM conftest*
# SGI C++ compiler will create directory out/ii_files/ for
# template instantiation
test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
$RM out/* && rmdir out
cd ..
$RM -r conftest
$RM conftest*
])
_LT_TAGDECL([compiler_c_o], [lt_cv_prog_compiler_c_o], [1],
[Does compiler simultaneously support -c and -o options?])
])# _LT_COMPILER_C_O
# _LT_COMPILER_FILE_LOCKS([TAGNAME])
# ----------------------------------
# Check to see if we can do hard links to lock some files if needed
m4_defun([_LT_COMPILER_FILE_LOCKS],
[m4_require([_LT_ENABLE_LOCK])dnl
m4_require([_LT_FILEUTILS_DEFAULTS])dnl
_LT_COMPILER_C_O([$1])
hard_links="nottested"
if test "$_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)" = no && test "$need_locks" != no; then
# do not overwrite the value of need_locks provided by the user
AC_MSG_CHECKING([if we can lock with hard links])
hard_links=yes
$RM conftest*
ln conftest.a conftest.b 2>/dev/null && hard_links=no
touch conftest.a
ln conftest.a conftest.b 2>&5 || hard_links=no
ln conftest.a conftest.b 2>/dev/null && hard_links=no
AC_MSG_RESULT([$hard_links])
if test "$hard_links" = no; then
AC_MSG_WARN([`$CC' does not support `-c -o', so `make -j' may be unsafe])
need_locks=warn
fi
else
need_locks=no
fi
_LT_DECL([], [need_locks], [1], [Must we lock files when doing compilation?])
])# _LT_COMPILER_FILE_LOCKS
# _LT_CHECK_OBJDIR
# ----------------
m4_defun([_LT_CHECK_OBJDIR],
[AC_CACHE_CHECK([for objdir], [lt_cv_objdir],
[rm -f .libs 2>/dev/null
mkdir .libs 2>/dev/null
if test -d .libs; then
lt_cv_objdir=.libs
else
# MS-DOS does not allow filenames that begin with a dot.
lt_cv_objdir=_libs
fi
rmdir .libs 2>/dev/null])
objdir=$lt_cv_objdir
_LT_DECL([], [objdir], [0],
[The name of the directory that contains temporary libtool files])dnl
m4_pattern_allow([LT_OBJDIR])dnl
AC_DEFINE_UNQUOTED(LT_OBJDIR, "$lt_cv_objdir/",
[Define to the sub-directory in which libtool stores uninstalled libraries.])
])# _LT_CHECK_OBJDIR
# _LT_LINKER_HARDCODE_LIBPATH([TAGNAME])
# --------------------------------------
# Check hardcoding attributes.
m4_defun([_LT_LINKER_HARDCODE_LIBPATH],
[AC_MSG_CHECKING([how to hardcode library paths into programs])
_LT_TAGVAR(hardcode_action, $1)=
if test -n "$_LT_TAGVAR(hardcode_libdir_flag_spec, $1)" ||
test -n "$_LT_TAGVAR(runpath_var, $1)" ||
test "X$_LT_TAGVAR(hardcode_automatic, $1)" = "Xyes" ; then
# We can hardcode non-existent directories.
if test "$_LT_TAGVAR(hardcode_direct, $1)" != no &&
# If the only mechanism to avoid hardcoding is shlibpath_var, we
# have to relink, otherwise we might link with an installed library
# when we should be linking with a yet-to-be-installed one
## test "$_LT_TAGVAR(hardcode_shlibpath_var, $1)" != no &&
test "$_LT_TAGVAR(hardcode_minus_L, $1)" != no; then
# Linking always hardcodes the temporary library directory.
_LT_TAGVAR(hardcode_action, $1)=relink
else
# We can link without hardcoding, and we can hardcode nonexisting dirs.
_LT_TAGVAR(hardcode_action, $1)=immediate
fi
else
# We cannot hardcode anything, or else we can only hardcode existing
# directories.
_LT_TAGVAR(hardcode_action, $1)=unsupported
fi
AC_MSG_RESULT([$_LT_TAGVAR(hardcode_action, $1)])
if test "$_LT_TAGVAR(hardcode_action, $1)" = relink ||
test "$_LT_TAGVAR(inherit_rpath, $1)" = yes; then
# Fast installation is not supported
enable_fast_install=no
elif test "$shlibpath_overrides_runpath" = yes ||
test "$enable_shared" = no; then
# Fast installation is not necessary
enable_fast_install=needless
fi
_LT_TAGDECL([], [hardcode_action], [0],
[How to hardcode a shared library path into an executable])
])# _LT_LINKER_HARDCODE_LIBPATH
# _LT_CMD_STRIPLIB
# ----------------
m4_defun([_LT_CMD_STRIPLIB],
[m4_require([_LT_DECL_EGREP])
striplib=
old_striplib=
AC_MSG_CHECKING([whether stripping libraries is possible])
if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
test -z "$striplib" && striplib="$STRIP --strip-unneeded"
AC_MSG_RESULT([yes])
else
# FIXME - insert some real tests, host_os isn't really good enough
case $host_os in
darwin*)
if test -n "$STRIP" ; then
striplib="$STRIP -x"
old_striplib="$STRIP -S"
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
fi
;;
*)
AC_MSG_RESULT([no])
;;
esac
fi
_LT_DECL([], [old_striplib], [1], [Commands to strip libraries])
_LT_DECL([], [striplib], [1])
])# _LT_CMD_STRIPLIB
# _LT_SYS_DYNAMIC_LINKER([TAG])
# -----------------------------
# PORTME Fill in your ld.so characteristics
m4_defun([_LT_SYS_DYNAMIC_LINKER],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
m4_require([_LT_DECL_EGREP])dnl
m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_DECL_OBJDUMP])dnl
m4_require([_LT_DECL_SED])dnl
m4_require([_LT_CHECK_SHELL_FEATURES])dnl
AC_MSG_CHECKING([dynamic linker characteristics])
m4_if([$1],
[], [
if test "$GCC" = yes; then
case $host_os in
darwin*) lt_awk_arg="/^libraries:/,/LR/" ;;
*) lt_awk_arg="/^libraries:/" ;;
esac
case $host_os in
mingw* | cegcc*) lt_sed_strip_eq="s,=\([[A-Za-z]]:\),\1,g" ;;
*) lt_sed_strip_eq="s,=/,/,g" ;;
esac
lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq`
case $lt_search_path_spec in
*\;*)
# if the path contains ";" then we assume it to be the separator
# otherwise default to the standard path separator (i.e. ":") - it is
# assumed that no part of a normal pathname contains ";" but that should
# okay in the real world where ";" in dirpaths is itself problematic.
lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'`
;;
*)
lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"`
;;
esac
# Ok, now we have the path, separated by spaces, we can step through it
# and add multilib dir if necessary.
lt_tmp_lt_search_path_spec=
lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
for lt_sys_path in $lt_search_path_spec; do
if test -d "$lt_sys_path/$lt_multi_os_dir"; then
lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir"
else
test -d "$lt_sys_path" && \
lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
fi
done
lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk '
BEGIN {RS=" "; FS="/|\n";} {
lt_foo="";
lt_count=0;
for (lt_i = NF; lt_i > 0; lt_i--) {
if ($lt_i != "" && $lt_i != ".") {
if ($lt_i == "..") {
lt_count++;
} else {
if (lt_count == 0) {
lt_foo="/" $lt_i lt_foo;
} else {
lt_count--;
}
}
}
}
if (lt_foo != "") { lt_freq[[lt_foo]]++; }
if (lt_freq[[lt_foo]] == 1) { print lt_foo; }
}'`
# AWK program above erroneously prepends '/' to C:/dos/paths
# for these hosts.
case $host_os in
mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\
$SED 's,/\([[A-Za-z]]:\),\1,g'` ;;
esac
sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP`
else
sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
fi])
library_names_spec=
libname_spec='lib$name'
soname_spec=
shrext_cmds=".so"
postinstall_cmds=
postuninstall_cmds=
finish_cmds=
finish_eval=
shlibpath_var=
shlibpath_overrides_runpath=unknown
version_type=none
dynamic_linker="$host_os ld.so"
sys_lib_dlsearch_path_spec="/lib /usr/lib"
need_lib_prefix=unknown
hardcode_into_libs=no
# when you set need_version to no, make sure it does not cause -set_version
# flags to be left without arguments
need_version=unknown
case $host_os in
aix3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
shlibpath_var=LIBPATH
# AIX 3 has no versioning support, so we append a major version to the name.
soname_spec='${libname}${release}${shared_ext}$major'
;;
aix[[4-9]]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
hardcode_into_libs=yes
if test "$host_cpu" = ia64; then
# AIX 5 supports IA64
library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
else
# With GCC up to 2.95.x, collect2 would create an import file
# for dependence libraries. The import file would start with
# the line `#! .'. This would cause the generated library to
# depend on `.', always an invalid library. This was fixed in
# development snapshots of GCC prior to 3.0.
case $host_os in
aix4 | aix4.[[01]] | aix4.[[01]].*)
if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
echo ' yes '
echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
:
else
can_build_shared=no
fi
;;
esac
# AIX (on Power*) has no versioning support, so currently we can not hardcode correct
# soname into executable. Probably we can add versioning support to
# collect2, so additional links can be useful in future.
if test "$aix_use_runtimelinking" = yes; then
# If using run time linking (on AIX 4.2 or later) use lib.so
# instead of lib.a to let people know that these are not
# typical AIX shared libraries.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
else
# We preserve .a as extension for shared libraries through AIX4.2
# and later when we are not doing run time linking.
library_names_spec='${libname}${release}.a $libname.a'
soname_spec='${libname}${release}${shared_ext}$major'
fi
shlibpath_var=LIBPATH
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# Since July 2007 AmigaOS4 officially supports .so libraries.
# When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
;;
m68k)
library_names_spec='$libname.ixlibrary $libname.a'
# Create ${libname}_ixlibrary.a entries in /sys/libs.
finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
;;
esac
;;
beos*)
library_names_spec='${libname}${shared_ext}'
dynamic_linker="$host_os ld.so"
shlibpath_var=LIBRARY_PATH
;;
bsdi[[45]]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
# the default ld.so.conf also contains /usr/contrib/lib and
# /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
# libtool to hard-code these into programs
;;
cygwin* | mingw* | pw32* | cegcc*)
version_type=windows
shrext_cmds=".dll"
need_version=no
need_lib_prefix=no
case $GCC,$cc_basename in
yes,*)
# gcc
library_names_spec='$libname.dll.a'
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname~
chmod a+x \$dldir/$dlname~
if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
fi'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
case $host_os in
cygwin*)
# Cygwin DLLs use 'cyg' prefix rather than 'lib'
soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
m4_if([$1], [],[
sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"])
;;
mingw* | cegcc*)
# MinGW DLLs use traditional 'lib' prefix
soname_spec='${libname}`echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
;;
pw32*)
# pw32 DLLs use 'pw' prefix rather than 'lib'
library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
;;
esac
dynamic_linker='Win32 ld.exe'
;;
*,cl*)
# Native MSVC
libname_spec='$name'
soname_spec='${libname}`echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext}'
library_names_spec='${libname}.dll.lib'
case $build_os in
mingw*)
sys_lib_search_path_spec=
lt_save_ifs=$IFS
IFS=';'
for lt_path in $LIB
do
IFS=$lt_save_ifs
# Let DOS variable expansion print the short 8.3 style file name.
lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"`
sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path"
done
IFS=$lt_save_ifs
# Convert to MSYS style.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([[a-zA-Z]]\\):| /\\1|g' -e 's|^ ||'`
;;
cygwin*)
# Convert to unix form, then to dos form, then back to unix form
# but this time dos style (no spaces!) so that the unix form looks
# like /cygdrive/c/PROGRA~1:/cygdr...
sys_lib_search_path_spec=`cygpath --path --unix "$LIB"`
sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null`
sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
;;
*)
sys_lib_search_path_spec="$LIB"
if $ECHO "$sys_lib_search_path_spec" | [$GREP ';[c-zC-Z]:/' >/dev/null]; then
# It is most probably a Windows format PATH.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
else
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
fi
# FIXME: find the short name or the path components, as spaces are
# common. (e.g. "Program Files" -> "PROGRA~1")
;;
esac
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
dynamic_linker='Win32 link.exe'
;;
*)
# Assume MSVC wrapper
library_names_spec='${libname}`echo ${release} | $SED -e 's/[[.]]/-/g'`${versuffix}${shared_ext} $libname.lib'
dynamic_linker='Win32 ld.exe'
;;
esac
# FIXME: first we should search . and the directory the executable is in
shlibpath_var=PATH
;;
darwin* | rhapsody*)
dynamic_linker="$host_os dyld"
version_type=darwin
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
soname_spec='${libname}${release}${major}$shared_ext'
shlibpath_overrides_runpath=yes
shlibpath_var=DYLD_LIBRARY_PATH
shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
m4_if([$1], [],[
sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"])
sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
;;
dgux*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
freebsd* | dragonfly*)
# DragonFly does not have aout. When/if they implement a new
# versioning mechanism, adjust this.
if test -x /usr/bin/objformat; then
objformat=`/usr/bin/objformat`
else
case $host_os in
freebsd[[23]].*) objformat=aout ;;
*) objformat=elf ;;
esac
fi
version_type=freebsd-$objformat
case $version_type in
freebsd-elf*)
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
need_version=no
need_lib_prefix=no
;;
freebsd-*)
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
need_version=yes
;;
esac
shlibpath_var=LD_LIBRARY_PATH
case $host_os in
freebsd2.*)
shlibpath_overrides_runpath=yes
;;
freebsd3.[[01]]* | freebsdelf3.[[01]]*)
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
freebsd3.[[2-9]]* | freebsdelf3.[[2-9]]* | \
freebsd4.[[0-5]] | freebsdelf4.[[0-5]] | freebsd4.1.1 | freebsdelf4.1.1)
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
*) # from 4.6 on, and DragonFly
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
esac
;;
gnu*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
haiku*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
dynamic_linker="$host_os runtime_loader"
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LIBRARY_PATH
shlibpath_overrides_runpath=yes
sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib'
hardcode_into_libs=yes
;;
hpux9* | hpux10* | hpux11*)
# Give a soname corresponding to the major version so that dld.sl refuses to
# link against other versions.
version_type=sunos
need_lib_prefix=no
need_version=no
case $host_cpu in
ia64*)
shrext_cmds='.so'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.so"
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
if test "X$HPUX_IA64_MODE" = X32; then
sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
else
sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
fi
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
hppa*64*)
shrext_cmds='.sl'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.sl"
shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
*)
shrext_cmds='.sl'
dynamic_linker="$host_os dld.sl"
shlibpath_var=SHLIB_PATH
shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
;;
esac
# HP-UX runs *really* slowly unless shared libraries are mode 555, ...
postinstall_cmds='chmod 555 $lib'
# or fails outright, so override atomically:
install_override_mode=555
;;
interix[[3-9]]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
irix5* | irix6* | nonstopux*)
case $host_os in
nonstopux*) version_type=nonstopux ;;
*)
if test "$lt_cv_prog_gnu_ld" = yes; then
version_type=linux # correct to gnu/linux during the next big refactor
else
version_type=irix
fi ;;
esac
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
case $host_os in
irix5* | nonstopux*)
libsuff= shlibsuff=
;;
*)
case $LD in # libtool.m4 will add one of these switches to LD
*-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
libsuff= shlibsuff= libmagic=32-bit;;
*-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
libsuff=32 shlibsuff=N32 libmagic=N32;;
*-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
libsuff=64 shlibsuff=64 libmagic=64-bit;;
*) libsuff= shlibsuff= libmagic=never-match;;
esac
;;
esac
shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
shlibpath_overrides_runpath=no
sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
hardcode_into_libs=yes
;;
# No shared lib support for Linux oldld, aout, or coff.
linux*oldld* | linux*aout* | linux*coff*)
dynamic_linker=no
;;
# This must be glibc/ELF.
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
# Some binutils ld are patched to set DT_RUNPATH
AC_CACHE_VAL([lt_cv_shlibpath_overrides_runpath],
[lt_cv_shlibpath_overrides_runpath=no
save_LDFLAGS=$LDFLAGS
save_libdir=$libdir
eval "libdir=/foo; wl=\"$_LT_TAGVAR(lt_prog_compiler_wl, $1)\"; \
LDFLAGS=\"\$LDFLAGS $_LT_TAGVAR(hardcode_libdir_flag_spec, $1)\""
AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])],
[AS_IF([ ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null],
[lt_cv_shlibpath_overrides_runpath=yes])])
LDFLAGS=$save_LDFLAGS
libdir=$save_libdir
])
shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
# This implies no fast_install, which is unacceptable.
# Some rework will be needed to allow for fast_install
# before this can be enabled.
hardcode_into_libs=yes
# Add ABI-specific directories to the system library path.
sys_lib_dlsearch_path_spec="/lib64 /usr/lib64 /lib /usr/lib"
# Append ld.so.conf contents to the search path
if test -f /etc/ld.so.conf; then
lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \[$]2)); skip = 1; } { if (!skip) print \[$]0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
sys_lib_dlsearch_path_spec="$sys_lib_dlsearch_path_spec $lt_ld_extra"
fi
# We used to test for /lib/ld.so.1 and disable shared libraries on
# powerpc, because MkLinux only supported shared libraries with the
# GNU dynamic linker. Since this was broken with cross compilers,
# most powerpc-linux boxes support dynamic linking these days and
# people can always --disable-shared, the test was removed, and we
# assume the GNU/Linux dynamic linker is in use.
dynamic_linker='GNU/Linux ld.so'
;;
netbsd*)
version_type=sunos
need_lib_prefix=no
need_version=no
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
dynamic_linker='NetBSD (a.out) ld.so'
else
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='NetBSD ld.elf_so'
fi
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
newsos6)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
;;
*nto* | *qnx*)
version_type=qnx
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
dynamic_linker='ldqnx.so'
;;
openbsd*)
version_type=sunos
sys_lib_dlsearch_path_spec="/usr/lib"
need_lib_prefix=no
# Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
case $host_os in
openbsd3.3 | openbsd3.3.*) need_version=yes ;;
*) need_version=no ;;
esac
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
shlibpath_var=LD_LIBRARY_PATH
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
case $host_os in
openbsd2.[[89]] | openbsd2.[[89]].*)
shlibpath_overrides_runpath=no
;;
*)
shlibpath_overrides_runpath=yes
;;
esac
else
shlibpath_overrides_runpath=yes
fi
;;
os2*)
libname_spec='$name'
shrext_cmds=".dll"
need_lib_prefix=no
library_names_spec='$libname${shared_ext} $libname.a'
dynamic_linker='OS/2 ld.exe'
shlibpath_var=LIBPATH
;;
osf3* | osf4* | osf5*)
version_type=osf
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
;;
rdos*)
dynamic_linker=no
;;
solaris*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
# ldd complains unless libraries are executable
postinstall_cmds='chmod +x $lib'
;;
sunos4*)
version_type=sunos
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
if test "$with_gnu_ld" = yes; then
need_lib_prefix=no
fi
need_version=yes
;;
sysv4 | sysv4.3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
case $host_vendor in
sni)
shlibpath_overrides_runpath=no
need_lib_prefix=no
runpath_var=LD_RUN_PATH
;;
siemens)
need_lib_prefix=no
;;
motorola)
need_lib_prefix=no
need_version=no
shlibpath_overrides_runpath=no
sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
;;
esac
;;
sysv4*MP*)
if test -d /usr/nec ;then
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
soname_spec='$libname${shared_ext}.$major'
shlibpath_var=LD_LIBRARY_PATH
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
version_type=freebsd-elf
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
if test "$with_gnu_ld" = yes; then
sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
else
sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
case $host_os in
sco3.2v5*)
sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
;;
esac
fi
sys_lib_dlsearch_path_spec='/usr/lib'
;;
tpf*)
# TPF is a cross-target only. Preferred cross-host = GNU/Linux.
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
uts4*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
*)
dynamic_linker=no
;;
esac
AC_MSG_RESULT([$dynamic_linker])
test "$dynamic_linker" = no && can_build_shared=no
variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
if test "$GCC" = yes; then
variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
fi
if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
fi
if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
fi
_LT_DECL([], [variables_saved_for_relink], [1],
[Variables whose values should be saved in libtool wrapper scripts and
restored at link time])
_LT_DECL([], [need_lib_prefix], [0],
[Do we need the "lib" prefix for modules?])
_LT_DECL([], [need_version], [0], [Do we need a version for libraries?])
_LT_DECL([], [version_type], [0], [Library versioning type])
_LT_DECL([], [runpath_var], [0], [Shared library runtime path variable])
_LT_DECL([], [shlibpath_var], [0],[Shared library path variable])
_LT_DECL([], [shlibpath_overrides_runpath], [0],
[Is shlibpath searched before the hard-coded library search path?])
_LT_DECL([], [libname_spec], [1], [Format of library name prefix])
_LT_DECL([], [library_names_spec], [1],
[[List of archive names. First name is the real one, the rest are links.
The last name is the one that the linker finds with -lNAME]])
_LT_DECL([], [soname_spec], [1],
[[The coded name of the library, if different from the real name]])
_LT_DECL([], [install_override_mode], [1],
[Permission mode override for installation of shared libraries])
_LT_DECL([], [postinstall_cmds], [2],
[Command to use after installation of a shared archive])
_LT_DECL([], [postuninstall_cmds], [2],
[Command to use after uninstallation of a shared archive])
_LT_DECL([], [finish_cmds], [2],
[Commands used to finish a libtool library installation in a directory])
_LT_DECL([], [finish_eval], [1],
[[As "finish_cmds", except a single script fragment to be evaled but
not shown]])
_LT_DECL([], [hardcode_into_libs], [0],
[Whether we should hardcode library paths into libraries])
_LT_DECL([], [sys_lib_search_path_spec], [2],
[Compile-time system search path for libraries])
_LT_DECL([], [sys_lib_dlsearch_path_spec], [2],
[Run-time system search path for libraries])
])# _LT_SYS_DYNAMIC_LINKER
# _LT_PATH_TOOL_PREFIX(TOOL)
# --------------------------
# find a file program which can recognize shared library
AC_DEFUN([_LT_PATH_TOOL_PREFIX],
[m4_require([_LT_DECL_EGREP])dnl
AC_MSG_CHECKING([for $1])
AC_CACHE_VAL(lt_cv_path_MAGIC_CMD,
[case $MAGIC_CMD in
[[\\/*] | ?:[\\/]*])
lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
;;
*)
lt_save_MAGIC_CMD="$MAGIC_CMD"
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
dnl $ac_dummy forces splitting on constant user-supplied paths.
dnl POSIX.2 word splitting is done only on the output of word expansions,
dnl not every word. This closes a longstanding sh security hole.
ac_dummy="m4_if([$2], , $PATH, [$2])"
for ac_dir in $ac_dummy; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/$1; then
lt_cv_path_MAGIC_CMD="$ac_dir/$1"
if test -n "$file_magic_test_file"; then
case $deplibs_check_method in
"file_magic "*)
file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
$EGREP "$file_magic_regex" > /dev/null; then
:
else
cat <<_LT_EOF 1>&2
*** Warning: the command libtool uses to detect shared libraries,
*** $file_magic_cmd, produces output that libtool cannot recognize.
*** The result is that libtool may fail to recognize shared libraries
*** as such. This will affect the creation of libtool libraries that
*** depend on shared libraries, but programs linked with such libtool
*** libraries will work regardless of this problem. Nevertheless, you
*** may want to report the problem to your system manager and/or to
*** bug-libtool@gnu.org
_LT_EOF
fi ;;
esac
fi
break
fi
done
IFS="$lt_save_ifs"
MAGIC_CMD="$lt_save_MAGIC_CMD"
;;
esac])
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if test -n "$MAGIC_CMD"; then
AC_MSG_RESULT($MAGIC_CMD)
else
AC_MSG_RESULT(no)
fi
_LT_DECL([], [MAGIC_CMD], [0],
[Used to examine libraries when file_magic_cmd begins with "file"])dnl
])# _LT_PATH_TOOL_PREFIX
# Old name:
AU_ALIAS([AC_PATH_TOOL_PREFIX], [_LT_PATH_TOOL_PREFIX])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_PATH_TOOL_PREFIX], [])
# _LT_PATH_MAGIC
# --------------
# find a file program which can recognize a shared library
m4_defun([_LT_PATH_MAGIC],
[_LT_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin$PATH_SEPARATOR$PATH)
if test -z "$lt_cv_path_MAGIC_CMD"; then
if test -n "$ac_tool_prefix"; then
_LT_PATH_TOOL_PREFIX(file, /usr/bin$PATH_SEPARATOR$PATH)
else
MAGIC_CMD=:
fi
fi
])# _LT_PATH_MAGIC
# LT_PATH_LD
# ----------
# find the pathname to the GNU or non-GNU linker
AC_DEFUN([LT_PATH_LD],
[AC_REQUIRE([AC_PROG_CC])dnl
AC_REQUIRE([AC_CANONICAL_HOST])dnl
AC_REQUIRE([AC_CANONICAL_BUILD])dnl
m4_require([_LT_DECL_SED])dnl
m4_require([_LT_DECL_EGREP])dnl
m4_require([_LT_PROG_ECHO_BACKSLASH])dnl
AC_ARG_WITH([gnu-ld],
[AS_HELP_STRING([--with-gnu-ld],
[assume the C compiler uses GNU ld @<:@default=no@:>@])],
[test "$withval" = no || with_gnu_ld=yes],
[with_gnu_ld=no])dnl
ac_prog=ld
if test "$GCC" = yes; then
# Check if gcc -print-prog-name=ld gives a path.
AC_MSG_CHECKING([for ld used by $CC])
case $host in
*-*-mingw*)
# gcc leaves a trailing carriage return which upsets mingw
ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
*)
ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
esac
case $ac_prog in
# Accept absolute paths.
[[\\/]]* | ?:[[\\/]]*)
re_direlt='/[[^/]][[^/]]*/\.\./'
# Canonicalize the pathname of ld
ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
done
test -z "$LD" && LD="$ac_prog"
;;
"")
# If it fails, then pretend we aren't using GCC.
ac_prog=ld
;;
*)
# If it is relative, then search for the first ld in PATH.
with_gnu_ld=unknown
;;
esac
elif test "$with_gnu_ld" = yes; then
AC_MSG_CHECKING([for GNU ld])
else
AC_MSG_CHECKING([for non-GNU ld])
fi
AC_CACHE_VAL(lt_cv_path_LD,
[if test -z "$LD"; then
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
for ac_dir in $PATH; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
lt_cv_path_LD="$ac_dir/$ac_prog"
# Check to see if the program is GNU ld. I'd rather use --version,
# but apparently some variants of GNU ld only accept -v.
# Break only if it was the GNU/non-GNU ld that we prefer.
case `"$lt_cv_path_LD" -v 2>&1 &1 /dev/null 2>&1; then
lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
lt_cv_file_magic_cmd='func_win32_libid'
else
# Keep this pattern in sync with the one in func_win32_libid.
lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)'
lt_cv_file_magic_cmd='$OBJDUMP -f'
fi
;;
cegcc*)
# use the weaker test based on 'objdump'. See mingw*.
lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
lt_cv_file_magic_cmd='$OBJDUMP -f'
;;
darwin* | rhapsody*)
lt_cv_deplibs_check_method=pass_all
;;
freebsd* | dragonfly*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
case $host_cpu in
i*86 )
# Not sure whether the presence of OpenBSD here was a mistake.
# Let's accept both of them until this is cleared up.
lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[[3-9]]86 (compact )?demand paged shared library'
lt_cv_file_magic_cmd=/usr/bin/file
lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
;;
esac
else
lt_cv_deplibs_check_method=pass_all
fi
;;
gnu*)
lt_cv_deplibs_check_method=pass_all
;;
haiku*)
lt_cv_deplibs_check_method=pass_all
;;
hpux10.20* | hpux11*)
lt_cv_file_magic_cmd=/usr/bin/file
case $host_cpu in
ia64*)
lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|ELF-[[0-9]][[0-9]]) shared object file - IA64'
lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
;;
hppa*64*)
[lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]']
lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
;;
*)
lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]]\.[[0-9]]) shared library'
lt_cv_file_magic_test_file=/usr/lib/libc.sl
;;
esac
;;
interix[[3-9]]*)
# PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|\.a)$'
;;
irix5* | irix6* | nonstopux*)
case $LD in
*-32|*"-32 ") libmagic=32-bit;;
*-n32|*"-n32 ") libmagic=N32;;
*-64|*"-64 ") libmagic=64-bit;;
*) libmagic=never-match;;
esac
lt_cv_deplibs_check_method=pass_all
;;
# This must be glibc/ELF.
linux* | k*bsd*-gnu | kopensolaris*-gnu)
lt_cv_deplibs_check_method=pass_all
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
else
lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|_pic\.a)$'
fi
;;
newos6*)
lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)'
lt_cv_file_magic_cmd=/usr/bin/file
lt_cv_file_magic_test_file=/usr/lib/libnls.so
;;
*nto* | *qnx*)
lt_cv_deplibs_check_method=pass_all
;;
openbsd*)
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|\.so|_pic\.a)$'
else
lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$'
fi
;;
osf3* | osf4* | osf5*)
lt_cv_deplibs_check_method=pass_all
;;
rdos*)
lt_cv_deplibs_check_method=pass_all
;;
solaris*)
lt_cv_deplibs_check_method=pass_all
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
lt_cv_deplibs_check_method=pass_all
;;
sysv4 | sysv4.3*)
case $host_vendor in
motorola)
lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]'
lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
;;
ncr)
lt_cv_deplibs_check_method=pass_all
;;
sequent)
lt_cv_file_magic_cmd='/bin/file'
lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )'
;;
sni)
lt_cv_file_magic_cmd='/bin/file'
lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib"
lt_cv_file_magic_test_file=/lib/libc.so
;;
siemens)
lt_cv_deplibs_check_method=pass_all
;;
pc)
lt_cv_deplibs_check_method=pass_all
;;
esac
;;
tpf*)
lt_cv_deplibs_check_method=pass_all
;;
esac
])
file_magic_glob=
want_nocaseglob=no
if test "$build" = "$host"; then
case $host_os in
mingw* | pw32*)
if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then
want_nocaseglob=yes
else
file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[[\1]]\/[[\1]]\/g;/g"`
fi
;;
esac
fi
file_magic_cmd=$lt_cv_file_magic_cmd
deplibs_check_method=$lt_cv_deplibs_check_method
test -z "$deplibs_check_method" && deplibs_check_method=unknown
_LT_DECL([], [deplibs_check_method], [1],
[Method to check whether dependent libraries are shared objects])
_LT_DECL([], [file_magic_cmd], [1],
[Command to use when deplibs_check_method = "file_magic"])
_LT_DECL([], [file_magic_glob], [1],
[How to find potential files when deplibs_check_method = "file_magic"])
_LT_DECL([], [want_nocaseglob], [1],
[Find potential files using nocaseglob when deplibs_check_method = "file_magic"])
])# _LT_CHECK_MAGIC_METHOD
# LT_PATH_NM
# ----------
# find the pathname to a BSD- or MS-compatible name lister
AC_DEFUN([LT_PATH_NM],
[AC_REQUIRE([AC_PROG_CC])dnl
AC_CACHE_CHECK([for BSD- or MS-compatible name lister (nm)], lt_cv_path_NM,
[if test -n "$NM"; then
# Let the user override the test.
lt_cv_path_NM="$NM"
else
lt_nm_to_check="${ac_tool_prefix}nm"
if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
lt_nm_to_check="$lt_nm_to_check nm"
fi
for lt_tmp_nm in $lt_nm_to_check; do
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
tmp_nm="$ac_dir/$lt_tmp_nm"
if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then
# Check to see if the nm accepts a BSD-compat flag.
# Adding the `sed 1q' prevents false positives on HP-UX, which says:
# nm: unknown option "B" ignored
# Tru64's nm complains that /dev/null is an invalid object file
case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in
*/dev/null* | *'Invalid file or object type'*)
lt_cv_path_NM="$tmp_nm -B"
break
;;
*)
case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
*/dev/null*)
lt_cv_path_NM="$tmp_nm -p"
break
;;
*)
lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
continue # so that we can try to find one that supports BSD flags
;;
esac
;;
esac
fi
done
IFS="$lt_save_ifs"
done
: ${lt_cv_path_NM=no}
fi])
if test "$lt_cv_path_NM" != "no"; then
NM="$lt_cv_path_NM"
else
# Didn't find any BSD compatible name lister, look for dumpbin.
if test -n "$DUMPBIN"; then :
# Let the user override the test.
else
AC_CHECK_TOOLS(DUMPBIN, [dumpbin "link -dump"], :)
case `$DUMPBIN -symbols /dev/null 2>&1 | sed '1q'` in
*COFF*)
DUMPBIN="$DUMPBIN -symbols"
;;
*)
DUMPBIN=:
;;
esac
fi
AC_SUBST([DUMPBIN])
if test "$DUMPBIN" != ":"; then
NM="$DUMPBIN"
fi
fi
test -z "$NM" && NM=nm
AC_SUBST([NM])
_LT_DECL([], [NM], [1], [A BSD- or MS-compatible name lister])dnl
AC_CACHE_CHECK([the name lister ($NM) interface], [lt_cv_nm_interface],
[lt_cv_nm_interface="BSD nm"
echo "int some_variable = 0;" > conftest.$ac_ext
(eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&AS_MESSAGE_LOG_FD)
(eval "$ac_compile" 2>conftest.err)
cat conftest.err >&AS_MESSAGE_LOG_FD
(eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&AS_MESSAGE_LOG_FD)
(eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
cat conftest.err >&AS_MESSAGE_LOG_FD
(eval echo "\"\$as_me:$LINENO: output\"" >&AS_MESSAGE_LOG_FD)
cat conftest.out >&AS_MESSAGE_LOG_FD
if $GREP 'External.*some_variable' conftest.out > /dev/null; then
lt_cv_nm_interface="MS dumpbin"
fi
rm -f conftest*])
])# LT_PATH_NM
# Old names:
AU_ALIAS([AM_PROG_NM], [LT_PATH_NM])
AU_ALIAS([AC_PROG_NM], [LT_PATH_NM])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AM_PROG_NM], [])
dnl AC_DEFUN([AC_PROG_NM], [])
# _LT_CHECK_SHAREDLIB_FROM_LINKLIB
# --------------------------------
# how to determine the name of the shared library
# associated with a specific link library.
# -- PORTME fill in with the dynamic library characteristics
m4_defun([_LT_CHECK_SHAREDLIB_FROM_LINKLIB],
[m4_require([_LT_DECL_EGREP])
m4_require([_LT_DECL_OBJDUMP])
m4_require([_LT_DECL_DLLTOOL])
AC_CACHE_CHECK([how to associate runtime and link libraries],
lt_cv_sharedlib_from_linklib_cmd,
[lt_cv_sharedlib_from_linklib_cmd='unknown'
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
# two different shell functions defined in ltmain.sh
# decide which to use based on capabilities of $DLLTOOL
case `$DLLTOOL --help 2>&1` in
*--identify-strict*)
lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib
;;
*)
lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback
;;
esac
;;
*)
# fallback: assume linklib IS sharedlib
lt_cv_sharedlib_from_linklib_cmd="$ECHO"
;;
esac
])
sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd
test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO
_LT_DECL([], [sharedlib_from_linklib_cmd], [1],
[Command to associate shared and link libraries])
])# _LT_CHECK_SHAREDLIB_FROM_LINKLIB
# _LT_PATH_MANIFEST_TOOL
# ----------------------
# locate the manifest tool
m4_defun([_LT_PATH_MANIFEST_TOOL],
[AC_CHECK_TOOL(MANIFEST_TOOL, mt, :)
test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt
AC_CACHE_CHECK([if $MANIFEST_TOOL is a manifest tool], [lt_cv_path_mainfest_tool],
[lt_cv_path_mainfest_tool=no
echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&AS_MESSAGE_LOG_FD
$MANIFEST_TOOL '-?' 2>conftest.err > conftest.out
cat conftest.err >&AS_MESSAGE_LOG_FD
if $GREP 'Manifest Tool' conftest.out > /dev/null; then
lt_cv_path_mainfest_tool=yes
fi
rm -f conftest*])
if test "x$lt_cv_path_mainfest_tool" != xyes; then
MANIFEST_TOOL=:
fi
_LT_DECL([], [MANIFEST_TOOL], [1], [Manifest tool])dnl
])# _LT_PATH_MANIFEST_TOOL
# LT_LIB_M
# --------
# check for math library
AC_DEFUN([LT_LIB_M],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
LIBM=
case $host in
*-*-beos* | *-*-cegcc* | *-*-cygwin* | *-*-haiku* | *-*-pw32* | *-*-darwin*)
# These system don't have libm, or don't need it
;;
*-ncr-sysv4.3*)
AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
AC_CHECK_LIB(m, cos, LIBM="$LIBM -lm")
;;
*)
AC_CHECK_LIB(m, cos, LIBM="-lm")
;;
esac
AC_SUBST([LIBM])
])# LT_LIB_M
# Old name:
AU_ALIAS([AC_CHECK_LIBM], [LT_LIB_M])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([AC_CHECK_LIBM], [])
# _LT_COMPILER_NO_RTTI([TAGNAME])
# -------------------------------
m4_defun([_LT_COMPILER_NO_RTTI],
[m4_require([_LT_TAG_COMPILER])dnl
_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
if test "$GCC" = yes; then
case $cc_basename in
nvcc*)
_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -Xcompiler -fno-builtin' ;;
*)
_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin' ;;
esac
_LT_COMPILER_OPTION([if $compiler supports -fno-rtti -fno-exceptions],
lt_cv_prog_compiler_rtti_exceptions,
[-fno-rtti -fno-exceptions], [],
[_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)="$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1) -fno-rtti -fno-exceptions"])
fi
_LT_TAGDECL([no_builtin_flag], [lt_prog_compiler_no_builtin_flag], [1],
[Compiler flag to turn off builtin functions])
])# _LT_COMPILER_NO_RTTI
# _LT_CMD_GLOBAL_SYMBOLS
# ----------------------
m4_defun([_LT_CMD_GLOBAL_SYMBOLS],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
AC_REQUIRE([AC_PROG_CC])dnl
AC_REQUIRE([AC_PROG_AWK])dnl
AC_REQUIRE([LT_PATH_NM])dnl
AC_REQUIRE([LT_PATH_LD])dnl
m4_require([_LT_DECL_SED])dnl
m4_require([_LT_DECL_EGREP])dnl
m4_require([_LT_TAG_COMPILER])dnl
# Check for command to grab the raw symbol name followed by C symbol from nm.
AC_MSG_CHECKING([command to parse $NM output from $compiler object])
AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe],
[
# These are sane defaults that work on at least a few old systems.
# [They come from Ultrix. What could be older than Ultrix?!! ;)]
# Character class describing NM global symbol codes.
symcode='[[BCDEGRST]]'
# Regexp to match symbols that can be accessed directly from C.
sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)'
# Define system-specific variables.
case $host_os in
aix*)
symcode='[[BCDT]]'
;;
cygwin* | mingw* | pw32* | cegcc*)
symcode='[[ABCDGISTW]]'
;;
hpux*)
if test "$host_cpu" = ia64; then
symcode='[[ABCDEGRST]]'
fi
;;
irix* | nonstopux*)
symcode='[[BCDEGRST]]'
;;
osf*)
symcode='[[BCDEGQRST]]'
;;
solaris*)
symcode='[[BDRT]]'
;;
sco3.2v5*)
symcode='[[DT]]'
;;
sysv4.2uw2*)
symcode='[[DT]]'
;;
sysv5* | sco5v6* | unixware* | OpenUNIX*)
symcode='[[ABDT]]'
;;
sysv4)
symcode='[[DFNSTU]]'
;;
esac
# If we're using GNU nm, then use its standard symbol codes.
case `$NM -V 2>&1` in
*GNU* | *'with BFD'*)
symcode='[[ABCDGIRSTW]]' ;;
esac
# Transform an extracted symbol line into a proper C declaration.
# Some systems (esp. on ia64) link data and code symbols differently,
# so use this general approach.
lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
# Transform an extracted symbol line into symbol name and symbol address
lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([[^ ]]*\)[[ ]]*$/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"\2\", (void *) \&\2},/p'"
lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([[^ ]]*\)[[ ]]*$/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([[^ ]]*\) \(lib[[^ ]]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([[^ ]]*\) \([[^ ]]*\)$/ {\"lib\2\", (void *) \&\2},/p'"
# Handle CRLF in mingw tool chain
opt_cr=
case $build_os in
mingw*)
opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
;;
esac
# Try without a prefix underscore, then with it.
for ac_symprfx in "" "_"; do
# Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
symxfrm="\\1 $ac_symprfx\\2 \\2"
# Write the raw and C identifiers.
if test "$lt_cv_nm_interface" = "MS dumpbin"; then
# Fake it for dumpbin and say T for any non-static function
# and D for any global variable.
# Also find C++ and __fastcall symbols from MSVC++,
# which start with @ or ?.
lt_cv_sys_global_symbol_pipe="$AWK ['"\
" {last_section=section; section=\$ 3};"\
" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\
" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
" \$ 0!~/External *\|/{next};"\
" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
" {if(hide[section]) next};"\
" {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\
" {split(\$ 0, a, /\||\r/); split(a[2], s)};"\
" s[1]~/^[@?]/{print s[1], s[1]; next};"\
" s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\
" ' prfx=^$ac_symprfx]"
else
lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[ ]]\($symcode$symcode*\)[[ ]][[ ]]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
fi
lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'"
# Check to see that the pipe works correctly.
pipe_works=no
rm -f conftest*
cat > conftest.$ac_ext <<_LT_EOF
#ifdef __cplusplus
extern "C" {
#endif
char nm_test_var;
void nm_test_func(void);
void nm_test_func(void){}
#ifdef __cplusplus
}
#endif
int main(){nm_test_var='a';nm_test_func();return(0);}
_LT_EOF
if AC_TRY_EVAL(ac_compile); then
# Now try to grab the symbols.
nlist=conftest.nm
if AC_TRY_EVAL(NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) && test -s "$nlist"; then
# Try sorting and uniquifying the output.
if sort "$nlist" | uniq > "$nlist"T; then
mv -f "$nlist"T "$nlist"
else
rm -f "$nlist"T
fi
# Make sure that we snagged all the symbols we need.
if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
cat <<_LT_EOF > conftest.$ac_ext
/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */
#if defined(_WIN32) || defined(__CYGWIN__) || defined(_WIN32_WCE)
/* DATA imports from DLLs on WIN32 con't be const, because runtime
relocations are performed -- see ld's documentation on pseudo-relocs. */
# define LT@&t@_DLSYM_CONST
#elif defined(__osf__)
/* This system does not cope well with relocations in const data. */
# define LT@&t@_DLSYM_CONST
#else
# define LT@&t@_DLSYM_CONST const
#endif
#ifdef __cplusplus
extern "C" {
#endif
_LT_EOF
# Now generate the symbol file.
eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
cat <<_LT_EOF >> conftest.$ac_ext
/* The mapping between symbol names and symbols. */
LT@&t@_DLSYM_CONST struct {
const char *name;
void *address;
}
lt__PROGRAM__LTX_preloaded_symbols[[]] =
{
{ "@PROGRAM@", (void *) 0 },
_LT_EOF
$SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
cat <<\_LT_EOF >> conftest.$ac_ext
{0, (void *) 0}
};
/* This works around a problem in FreeBSD linker */
#ifdef FREEBSD_WORKAROUND
static const void *lt_preloaded_setup() {
return lt__PROGRAM__LTX_preloaded_symbols;
}
#endif
#ifdef __cplusplus
}
#endif
_LT_EOF
# Now try linking the two files.
mv conftest.$ac_objext conftstm.$ac_objext
lt_globsym_save_LIBS=$LIBS
lt_globsym_save_CFLAGS=$CFLAGS
LIBS="conftstm.$ac_objext"
CFLAGS="$CFLAGS$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)"
if AC_TRY_EVAL(ac_link) && test -s conftest${ac_exeext}; then
pipe_works=yes
fi
LIBS=$lt_globsym_save_LIBS
CFLAGS=$lt_globsym_save_CFLAGS
else
echo "cannot find nm_test_func in $nlist" >&AS_MESSAGE_LOG_FD
fi
else
echo "cannot find nm_test_var in $nlist" >&AS_MESSAGE_LOG_FD
fi
else
echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AS_MESSAGE_LOG_FD
fi
else
echo "$progname: failed program was:" >&AS_MESSAGE_LOG_FD
cat conftest.$ac_ext >&5
fi
rm -rf conftest* conftst*
# Do not use the global_symbol_pipe unless it works.
if test "$pipe_works" = yes; then
break
else
lt_cv_sys_global_symbol_pipe=
fi
done
])
if test -z "$lt_cv_sys_global_symbol_pipe"; then
lt_cv_sys_global_symbol_to_cdecl=
fi
if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
AC_MSG_RESULT(failed)
else
AC_MSG_RESULT(ok)
fi
# Response file support.
if test "$lt_cv_nm_interface" = "MS dumpbin"; then
nm_file_list_spec='@'
elif $NM --help 2>/dev/null | grep '[[@]]FILE' >/dev/null; then
nm_file_list_spec='@'
fi
_LT_DECL([global_symbol_pipe], [lt_cv_sys_global_symbol_pipe], [1],
[Take the output of nm and produce a listing of raw symbols and C names])
_LT_DECL([global_symbol_to_cdecl], [lt_cv_sys_global_symbol_to_cdecl], [1],
[Transform the output of nm in a proper C declaration])
_LT_DECL([global_symbol_to_c_name_address],
[lt_cv_sys_global_symbol_to_c_name_address], [1],
[Transform the output of nm in a C name address pair])
_LT_DECL([global_symbol_to_c_name_address_lib_prefix],
[lt_cv_sys_global_symbol_to_c_name_address_lib_prefix], [1],
[Transform the output of nm in a C name address pair when lib prefix is needed])
_LT_DECL([], [nm_file_list_spec], [1],
[Specify filename containing input files for $NM])
]) # _LT_CMD_GLOBAL_SYMBOLS
# _LT_COMPILER_PIC([TAGNAME])
# ---------------------------
m4_defun([_LT_COMPILER_PIC],
[m4_require([_LT_TAG_COMPILER])dnl
_LT_TAGVAR(lt_prog_compiler_wl, $1)=
_LT_TAGVAR(lt_prog_compiler_pic, $1)=
_LT_TAGVAR(lt_prog_compiler_static, $1)=
m4_if([$1], [CXX], [
# C++ specific cases for pic, static, wl, etc.
if test "$GXX" = yes; then
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
case $host_os in
aix*)
# All AIX code is PIC.
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
m68k)
# FIXME: we need at least 68020 code to build shared libraries, but
# adding the `-m68020' flag to GCC prevents building anything better,
# like `-m68040'.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
;;
esac
;;
beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
# PIC is the default for these OSes.
;;
mingw* | cygwin* | os2* | pw32* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
# Although the cygwin gcc ignores -fPIC, still need this for old-style
# (--disable-auto-import) libraries
m4_if([$1], [GCJ], [],
[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
;;
darwin* | rhapsody*)
# PIC is the default on this platform
# Common symbols not allowed in MH_DYLIB files
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
;;
*djgpp*)
# DJGPP does not support shared libraries at all
_LT_TAGVAR(lt_prog_compiler_pic, $1)=
;;
haiku*)
# PIC is the default for Haiku.
# The "-static" flag exists, but is broken.
_LT_TAGVAR(lt_prog_compiler_static, $1)=
;;
interix[[3-9]]*)
# Interix 3.x gcc -fpic/-fPIC options generate broken code.
# Instead, we relocate shared libraries at runtime.
;;
sysv4*MP*)
if test -d /usr/nec; then
_LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
fi
;;
hpux*)
# PIC is the default for 64-bit PA HP-UX, but not for 32-bit
# PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
# sets the default TLS model and affects inlining.
case $host_cpu in
hppa*64*)
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
esac
;;
*qnx* | *nto*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
esac
else
case $host_os in
aix[[4-9]]*)
# All AIX code is PIC.
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
else
_LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
fi
;;
chorus*)
case $cc_basename in
cxch68*)
# Green Hills C++ Compiler
# _LT_TAGVAR(lt_prog_compiler_static, $1)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a"
;;
esac
;;
mingw* | cygwin* | os2* | pw32* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
m4_if([$1], [GCJ], [],
[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
;;
dgux*)
case $cc_basename in
ec++*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
;;
ghcx*)
# Green Hills C++ Compiler
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
;;
*)
;;
esac
;;
freebsd* | dragonfly*)
# FreeBSD uses GNU C++
;;
hpux9* | hpux10* | hpux11*)
case $cc_basename in
CC*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
if test "$host_cpu" != ia64; then
_LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
fi
;;
aCC*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
case $host_cpu in
hppa*64*|ia64*)
# +Z the default
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
;;
esac
;;
*)
;;
esac
;;
interix*)
# This is c89, which is MS Visual C++ (no shared libs)
# Anyone wants to do a port?
;;
irix5* | irix6* | nonstopux*)
case $cc_basename in
CC*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
# CC pic flag -KPIC is the default.
;;
*)
;;
esac
;;
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# KAI C++ Compiler
_LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
ecpc* )
# old Intel C++ for x86_64 which still supported -KPIC.
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
;;
icpc* )
# Intel C++, used to be incompatible with GCC.
# ICC 10 doesn't accept -KPIC any more.
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
;;
pgCC* | pgcpp*)
# Portland Group C++ compiler
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
cxx*)
# Compaq C++
# Make sure the PIC flag is empty. It appears that all Alpha
# Linux and Compaq Tru64 Unix objects are PIC.
_LT_TAGVAR(lt_prog_compiler_pic, $1)=
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
xlc* | xlC* | bgxl[[cC]]* | mpixl[[cC]]*)
# IBM XL 8.0, 9.0 on PPC and BlueGene
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
;;
*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*)
# Sun C++ 5.9
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
;;
esac
;;
esac
;;
lynxos*)
;;
m88k*)
;;
mvs*)
case $cc_basename in
cxx*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-W c,exportall'
;;
*)
;;
esac
;;
netbsd*)
;;
*qnx* | *nto*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
;;
osf3* | osf4* | osf5*)
case $cc_basename in
KCC*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,'
;;
RCC*)
# Rational C++ 2.4.1
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
;;
cxx*)
# Digital/Compaq C++
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
# Make sure the PIC flag is empty. It appears that all Alpha
# Linux and Compaq Tru64 Unix objects are PIC.
_LT_TAGVAR(lt_prog_compiler_pic, $1)=
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
*)
;;
esac
;;
psos*)
;;
solaris*)
case $cc_basename in
CC* | sunCC*)
# Sun C++ 4.2, 5.x and Centerline C++
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
;;
gcx*)
# Green Hills C++ Compiler
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
;;
*)
;;
esac
;;
sunos4*)
case $cc_basename in
CC*)
# Sun C++ 4.x
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
lcc*)
# Lucid
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
;;
*)
;;
esac
;;
sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
case $cc_basename in
CC*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
esac
;;
tandem*)
case $cc_basename in
NCC*)
# NonStop-UX NCC 3.20
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
;;
*)
;;
esac
;;
vxworks*)
;;
*)
_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
;;
esac
fi
],
[
if test "$GCC" = yes; then
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
case $host_os in
aix*)
# All AIX code is PIC.
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
m68k)
# FIXME: we need at least 68020 code to build shared libraries, but
# adding the `-m68020' flag to GCC prevents building anything better,
# like `-m68040'.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4'
;;
esac
;;
beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
# PIC is the default for these OSes.
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
# Although the cygwin gcc ignores -fPIC, still need this for old-style
# (--disable-auto-import) libraries
m4_if([$1], [GCJ], [],
[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
;;
darwin* | rhapsody*)
# PIC is the default on this platform
# Common symbols not allowed in MH_DYLIB files
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common'
;;
haiku*)
# PIC is the default for Haiku.
# The "-static" flag exists, but is broken.
_LT_TAGVAR(lt_prog_compiler_static, $1)=
;;
hpux*)
# PIC is the default for 64-bit PA HP-UX, but not for 32-bit
# PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
# sets the default TLS model and affects inlining.
case $host_cpu in
hppa*64*)
# +Z the default
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
esac
;;
interix[[3-9]]*)
# Interix 3.x gcc -fpic/-fPIC options generate broken code.
# Instead, we relocate shared libraries at runtime.
;;
msdosdjgpp*)
# Just because we use GCC doesn't mean we suddenly get shared libraries
# on systems that don't support them.
_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
enable_shared=no
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
;;
sysv4*MP*)
if test -d /usr/nec; then
_LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic
fi
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
;;
esac
case $cc_basename in
nvcc*) # Cuda Compiler Driver 2.2
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Xlinker '
if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then
_LT_TAGVAR(lt_prog_compiler_pic, $1)="-Xcompiler $_LT_TAGVAR(lt_prog_compiler_pic, $1)"
fi
;;
esac
else
# PORTME Check for flag to pass linker flags through the system compiler.
case $host_os in
aix*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
else
_LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp'
fi
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
m4_if([$1], [GCJ], [],
[_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT'])
;;
hpux9* | hpux10* | hpux11*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
# PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
# not for PA HP-UX.
case $host_cpu in
hppa*64*|ia64*)
# +Z the default
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z'
;;
esac
# Is there a better lt_prog_compiler_static that works with the bundled CC?
_LT_TAGVAR(lt_prog_compiler_static, $1)='${wl}-a ${wl}archive'
;;
irix5* | irix6* | nonstopux*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
# PIC (with -KPIC) is the default.
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
# old Intel for x86_64 which still supported -KPIC.
ecc*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
;;
# icc used to be incompatible with GCC.
# ICC 10 doesn't accept -KPIC any more.
icc* | ifort*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
;;
# Lahey Fortran 8.1.
lf95*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='--shared'
_LT_TAGVAR(lt_prog_compiler_static, $1)='--static'
;;
nagfor*)
# NAG Fortran compiler
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group compilers (*not* the Pentium gcc compiler,
# which looks to be a dead project)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
ccc*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
# All Alpha code is PIC.
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
xl* | bgxl* | bgf* | mpixl*)
# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink'
;;
*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [[1-7]].* | *Sun*Fortran*\ 8.[[0-3]]*)
# Sun Fortran 8.3 passes all unrecognized flags to the linker
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
_LT_TAGVAR(lt_prog_compiler_wl, $1)=''
;;
*Sun\ F* | *Sun*Fortran*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
;;
*Sun\ C*)
# Sun C 5.9
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
;;
*Intel*\ [[CF]]*Compiler*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-static'
;;
*Portland\ Group*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
esac
;;
esac
;;
newsos6)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared'
;;
osf3* | osf4* | osf5*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
# All OSF/1 code is PIC.
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
rdos*)
_LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared'
;;
solaris*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
case $cc_basename in
f77* | f90* | f95* | sunf77* | sunf90* | sunf95*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ';;
*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,';;
esac
;;
sunos4*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld '
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
sysv4 | sysv4.2uw2* | sysv4.3*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
sysv4*MP*)
if test -d /usr/nec ;then
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-Kconform_pic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
fi
;;
sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
unicos*)
_LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,'
_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
;;
uts4*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic'
_LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic'
;;
*)
_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no
;;
esac
fi
])
case $host_os in
# For platforms which do not support PIC, -DPIC is meaningless:
*djgpp*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)=
;;
*)
_LT_TAGVAR(lt_prog_compiler_pic, $1)="$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])"
;;
esac
AC_CACHE_CHECK([for $compiler option to produce PIC],
[_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)],
[_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_prog_compiler_pic, $1)])
_LT_TAGVAR(lt_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)
#
# Check to make sure the PIC flag actually works.
#
if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then
_LT_COMPILER_OPTION([if $compiler PIC flag $_LT_TAGVAR(lt_prog_compiler_pic, $1) works],
[_LT_TAGVAR(lt_cv_prog_compiler_pic_works, $1)],
[$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])], [],
[case $_LT_TAGVAR(lt_prog_compiler_pic, $1) in
"" | " "*) ;;
*) _LT_TAGVAR(lt_prog_compiler_pic, $1)=" $_LT_TAGVAR(lt_prog_compiler_pic, $1)" ;;
esac],
[_LT_TAGVAR(lt_prog_compiler_pic, $1)=
_LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no])
fi
_LT_TAGDECL([pic_flag], [lt_prog_compiler_pic], [1],
[Additional compiler flags for building library objects])
_LT_TAGDECL([wl], [lt_prog_compiler_wl], [1],
[How to pass a linker flag through the compiler])
#
# Check to make sure the static flag actually works.
#
wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1) eval lt_tmp_static_flag=\"$_LT_TAGVAR(lt_prog_compiler_static, $1)\"
_LT_LINKER_OPTION([if $compiler static flag $lt_tmp_static_flag works],
_LT_TAGVAR(lt_cv_prog_compiler_static_works, $1),
$lt_tmp_static_flag,
[],
[_LT_TAGVAR(lt_prog_compiler_static, $1)=])
_LT_TAGDECL([link_static_flag], [lt_prog_compiler_static], [1],
[Compiler flag to prevent dynamic linking])
])# _LT_COMPILER_PIC
# _LT_LINKER_SHLIBS([TAGNAME])
# ----------------------------
# See if the linker supports building shared libraries.
m4_defun([_LT_LINKER_SHLIBS],
[AC_REQUIRE([LT_PATH_LD])dnl
AC_REQUIRE([LT_PATH_NM])dnl
m4_require([_LT_PATH_MANIFEST_TOOL])dnl
m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_DECL_EGREP])dnl
m4_require([_LT_DECL_SED])dnl
m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl
m4_require([_LT_TAG_COMPILER])dnl
AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
m4_if([$1], [CXX], [
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
_LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
case $host_os in
aix[[4-9]]*)
# If we're using GNU nm, then we don't want the "-C" option.
# -C means demangle to AIX nm, but means don't demangle with GNU nm
# Also, AIX nm treats weak defined symbols like other global defined
# symbols, whereas GNU nm marks them as "W".
if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
_LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
else
_LT_TAGVAR(export_symbols_cmds, $1)='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
fi
;;
pw32*)
_LT_TAGVAR(export_symbols_cmds, $1)="$ltdll_cmds"
;;
cygwin* | mingw* | cegcc*)
case $cc_basename in
cl*)
_LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
;;
*)
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols'
_LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname']
;;
esac
;;
*)
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
;;
esac
], [
runpath_var=
_LT_TAGVAR(allow_undefined_flag, $1)=
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(archive_cmds, $1)=
_LT_TAGVAR(archive_expsym_cmds, $1)=
_LT_TAGVAR(compiler_needs_object, $1)=no
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
_LT_TAGVAR(export_dynamic_flag_spec, $1)=
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
_LT_TAGVAR(hardcode_automatic, $1)=no
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
_LT_TAGVAR(hardcode_libdir_separator, $1)=
_LT_TAGVAR(hardcode_minus_L, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
_LT_TAGVAR(inherit_rpath, $1)=no
_LT_TAGVAR(link_all_deplibs, $1)=unknown
_LT_TAGVAR(module_cmds, $1)=
_LT_TAGVAR(module_expsym_cmds, $1)=
_LT_TAGVAR(old_archive_from_new_cmds, $1)=
_LT_TAGVAR(old_archive_from_expsyms_cmds, $1)=
_LT_TAGVAR(thread_safe_flag_spec, $1)=
_LT_TAGVAR(whole_archive_flag_spec, $1)=
# include_expsyms should be a list of space-separated symbols to be *always*
# included in the symbol list
_LT_TAGVAR(include_expsyms, $1)=
# exclude_expsyms can be an extended regexp of symbols to exclude
# it will be wrapped by ` (' and `)$', so one must not match beginning or
# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
# as well as any symbol that contains `d'.
_LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*']
# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
# platforms (ab)use it in PIC code, but their linkers get confused if
# the symbol is explicitly referenced. Since portable code cannot
# rely on this symbol name, it's probably fine to never include it in
# preloaded symbol tables.
# Exclude shared library initialization/finalization symbols.
dnl Note also adjust exclude_expsyms for C++ above.
extract_expsyms_cmds=
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
# FIXME: the MSVC++ port hasn't been tested in a loooong time
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
if test "$GCC" != yes; then
with_gnu_ld=no
fi
;;
interix*)
# we just hope/assume this is gcc and not c89 (= MSVC++)
with_gnu_ld=yes
;;
openbsd*)
with_gnu_ld=no
;;
esac
_LT_TAGVAR(ld_shlibs, $1)=yes
# On some targets, GNU ld is compatible enough with the native linker
# that we're better off using the native interface for both.
lt_use_gnu_ld_interface=no
if test "$with_gnu_ld" = yes; then
case $host_os in
aix*)
# The AIX port of GNU ld has always aspired to compatibility
# with the native linker. However, as the warning in the GNU ld
# block says, versions before 2.19.5* couldn't really create working
# shared libraries, regardless of the interface used.
case `$LD -v 2>&1` in
*\ \(GNU\ Binutils\)\ 2.19.5*) ;;
*\ \(GNU\ Binutils\)\ 2.[[2-9]]*) ;;
*\ \(GNU\ Binutils\)\ [[3-9]]*) ;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
fi
if test "$lt_use_gnu_ld_interface" = yes; then
# If archive_cmds runs LD, not CC, wlarc should be empty
wlarc='${wl}'
# Set some defaults for GNU ld with shared library support. These
# are reset later if shared libraries are not supported. Putting them
# here allows them to be overridden if necessary.
runpath_var=LD_RUN_PATH
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
# ancient GNU ld didn't support --whole-archive et. al.
if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
_LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
else
_LT_TAGVAR(whole_archive_flag_spec, $1)=
fi
supports_anon_versioning=no
case `$LD -v 2>&1` in
*GNU\ gold*) supports_anon_versioning=yes ;;
*\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.10.*) ;; # catch versions < 2.11
*\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
*\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
*\ 2.11.*) ;; # other 2.11 versions
*) supports_anon_versioning=yes ;;
esac
# See if GNU ld supports shared libraries.
case $host_os in
aix[[3-9]]*)
# On AIX/PPC, the GNU linker is very broken
if test "$host_cpu" != ia64; then
_LT_TAGVAR(ld_shlibs, $1)=no
cat <<_LT_EOF 1>&2
*** Warning: the GNU linker, at least up to release 2.19, is reported
*** to be unable to reliably create shared libraries on AIX.
*** Therefore, libtool is disabling shared libraries support. If you
*** really care for shared libraries, you may want to install binutils
*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
*** You will then need to restart the configuration process.
_LT_EOF
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)=''
;;
m68k)
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_minus_L, $1)=yes
;;
esac
;;
beos*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
# Joseph Beckenbach says some releases of gcc
# support --undefined. This deserves some investigation. FIXME
_LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
cygwin* | mingw* | pw32* | cegcc*)
# _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
# as there is no search path for DLLs.
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-all-symbols'
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols'
_LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname']
if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
# If the export-symbols file already is a .def file (1st line
# is EXPORTS), use it as is; otherwise, prepend...
_LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
cp $export_symbols $output_objdir/$soname.def;
else
echo EXPORTS > $output_objdir/$soname.def;
cat $export_symbols >> $output_objdir/$soname.def;
fi~
$CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
haiku*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(link_all_deplibs, $1)=yes
;;
interix[[3-9]]*)
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
# Instead, shared libraries are loaded at an image base (0x10000000 by
# default) and relocated if they conflict, which is a slow very memory
# consuming and fragmenting process. To avoid this, we pick a random,
# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
# time. Moving up from 0x10000000 also allows more sbrk(2) space.
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
tmp_diet=no
if test "$host_os" = linux-dietlibc; then
case $cc_basename in
diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn)
esac
fi
if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
&& test "$tmp_diet" = no
then
tmp_addflag=' $pic_flag'
tmp_sharedflag='-shared'
case $cc_basename,$host_cpu in
pgcc*) # Portland Group C compiler
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag'
;;
pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group f77 and f90 compilers
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag -Mnomain' ;;
ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64
tmp_addflag=' -i_dynamic' ;;
efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64
tmp_addflag=' -i_dynamic -nofor_main' ;;
ifc* | ifort*) # Intel Fortran compiler
tmp_addflag=' -nofor_main' ;;
lf95*) # Lahey Fortran 8.1
_LT_TAGVAR(whole_archive_flag_spec, $1)=
tmp_sharedflag='--shared' ;;
xl[[cC]]* | bgxl[[cC]]* | mpixl[[cC]]*) # IBM XL C 8.0 on PPC (deal with xlf below)
tmp_sharedflag='-qmkshrobj'
tmp_addflag= ;;
nvcc*) # Cuda Compiler Driver 2.2
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
_LT_TAGVAR(compiler_needs_object, $1)=yes
;;
esac
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*) # Sun C 5.9
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
_LT_TAGVAR(compiler_needs_object, $1)=yes
tmp_sharedflag='-G' ;;
*Sun\ F*) # Sun Fortran 8.3
tmp_sharedflag='-G' ;;
esac
_LT_TAGVAR(archive_cmds, $1)='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
fi
case $cc_basename in
xlf* | bgf* | bgxlf* | mpixlf*)
# IBM XL Fortran 10.1 on PPC cannot create shared libs itself
_LT_TAGVAR(whole_archive_flag_spec, $1)='--whole-archive$convenience --no-whole-archive'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(archive_cmds, $1)='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
fi
;;
esac
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
wlarc=
else
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
fi
;;
solaris*)
if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
_LT_TAGVAR(ld_shlibs, $1)=no
cat <<_LT_EOF 1>&2
*** Warning: The releases 2.8.* of the GNU linker cannot reliably
*** create shared libraries on Solaris systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.9.1 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
case `$LD -v 2>&1` in
*\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.1[[0-5]].*)
_LT_TAGVAR(ld_shlibs, $1)=no
cat <<_LT_EOF 1>&2
*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not
*** reliably create shared libraries on SCO systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.16.91.0.3 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
;;
*)
# For security reasons, it is highly recommended that you always
# use absolute paths for naming shared libraries, and exclude the
# DT_RUNPATH tag from executables and libraries. But doing so
# requires that you compile everything twice, which is a pain.
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
;;
sunos4*)
_LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
wlarc=
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
if test "$_LT_TAGVAR(ld_shlibs, $1)" = no; then
runpath_var=
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
_LT_TAGVAR(export_dynamic_flag_spec, $1)=
_LT_TAGVAR(whole_archive_flag_spec, $1)=
fi
else
# PORTME fill in a description of your system's linker (not GNU ld)
case $host_os in
aix3*)
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(always_export_symbols, $1)=yes
_LT_TAGVAR(archive_expsym_cmds, $1)='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
# Note: this linker hardcodes the directories in LIBPATH if there
# are no directories specified by -L.
_LT_TAGVAR(hardcode_minus_L, $1)=yes
if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then
# Neither direct hardcoding nor static linking is supported with a
# broken collect2.
_LT_TAGVAR(hardcode_direct, $1)=unsupported
fi
;;
aix[[4-9]]*)
if test "$host_cpu" = ia64; then
# On IA64, the linker does run time linking by default, so we don't
# have to do anything special.
aix_use_runtimelinking=no
exp_sym_flag='-Bexport'
no_entry_flag=""
else
# If we're using GNU nm, then we don't want the "-C" option.
# -C means demangle to AIX nm, but means don't demangle with GNU nm
# Also, AIX nm treats weak defined symbols like other global
# defined symbols, whereas GNU nm marks them as "W".
if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
_LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
else
_LT_TAGVAR(export_symbols_cmds, $1)='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && ([substr](\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
fi
aix_use_runtimelinking=no
# Test if we are trying to use run time linking or normal
# AIX style linking. If -brtl is somewhere in LDFLAGS, we
# need to do runtime linking.
case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
for ld_flag in $LDFLAGS; do
if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
aix_use_runtimelinking=yes
break
fi
done
;;
esac
exp_sym_flag='-bexport'
no_entry_flag='-bnoentry'
fi
# When large executables or shared objects are built, AIX ld can
# have problems creating the table of contents. If linking a library
# or program results in "error TOC overflow" add -mminimal-toc to
# CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
# enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
_LT_TAGVAR(archive_cmds, $1)=''
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(hardcode_libdir_separator, $1)=':'
_LT_TAGVAR(link_all_deplibs, $1)=yes
_LT_TAGVAR(file_list_spec, $1)='${wl}-f,'
if test "$GCC" = yes; then
case $host_os in aix4.[[012]]|aix4.[[012]].*)
# We only want to do this on AIX 4.2 and lower, the check
# below for broken collect2 doesn't work under 4.3+
collect2name=`${CC} -print-prog-name=collect2`
if test -f "$collect2name" &&
strings "$collect2name" | $GREP resolve_lib_name >/dev/null
then
# We have reworked collect2
:
else
# We have old collect2
_LT_TAGVAR(hardcode_direct, $1)=unsupported
# It fails to find uninstalled libraries when the uninstalled
# path is not listed in the libpath. Setting hardcode_minus_L
# to unsupported forces relinking
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=
fi
;;
esac
shared_flag='-shared'
if test "$aix_use_runtimelinking" = yes; then
shared_flag="$shared_flag "'${wl}-G'
fi
else
# not using gcc
if test "$host_cpu" = ia64; then
# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
# chokes on -Wl,-G. The following line is correct:
shared_flag='-G'
else
if test "$aix_use_runtimelinking" = yes; then
shared_flag='${wl}-G'
else
shared_flag='${wl}-bM:SRE'
fi
fi
fi
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-bexpall'
# It seems that -bexpall does not export symbols beginning with
# underscore (_), so it is better to generate a list of symbols to export.
_LT_TAGVAR(always_export_symbols, $1)=yes
if test "$aix_use_runtimelinking" = yes; then
# Warning - without using the other runtime loading flags (-brtl),
# -berok will link without error, but may produce a broken library.
_LT_TAGVAR(allow_undefined_flag, $1)='-berok'
# Determine the default libpath from the value encoded in an
# empty executable.
_LT_SYS_MODULE_PATH_AIX([$1])
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
else
if test "$host_cpu" = ia64; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $libdir:/usr/lib:/lib'
_LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
_LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
else
# Determine the default libpath from the value encoded in an
# empty executable.
_LT_SYS_MODULE_PATH_AIX([$1])
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
# Warning - without using the other run time loading flags,
# -berok will link without error, but may produce a broken library.
_LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-bernotok'
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-berok'
if test "$with_gnu_ld" = yes; then
# We only use this code for GNU lds that support --whole-archive.
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
else
# Exported symbols can be pulled into shared objects from archives
_LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)=yes
# This is similar to how AIX traditionally builds its shared libraries.
_LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
fi
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)=''
;;
m68k)
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_minus_L, $1)=yes
;;
esac
;;
bsdi[[45]]*)
_LT_TAGVAR(export_dynamic_flag_spec, $1)=-rdynamic
;;
cygwin* | mingw* | pw32* | cegcc*)
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
# hardcode_libdir_flag_spec is actually meaningless, as there is
# no search path for DLLs.
case $cc_basename in
cl*)
# Native MSVC
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(always_export_symbols, $1)=yes
_LT_TAGVAR(file_list_spec, $1)='@'
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
_LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-dll~linknames='
_LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
sed -n -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' -e '1\\\!p' < $export_symbols > $output_objdir/$soname.exp;
else
sed -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' < $export_symbols > $output_objdir/$soname.exp;
fi~
$CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
linknames='
# The linker will not automatically build a static lib if we build a DLL.
# _LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
_LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
_LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1,DATA/'\'' | $SED -e '\''/^[[AITW]][[ ]]/s/.*[[ ]]//'\'' | sort | uniq > $export_symbols'
# Don't use ranlib
_LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib'
_LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~
lt_tool_outputfile="@TOOL_OUTPUT@"~
case $lt_outputfile in
*.exe|*.EXE) ;;
*)
lt_outputfile="$lt_outputfile.exe"
lt_tool_outputfile="$lt_tool_outputfile.exe"
;;
esac~
if test "$MANIFEST_TOOL" != ":" && test -f "$lt_outputfile.manifest"; then
$MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
$RM "$lt_outputfile.manifest";
fi'
;;
*)
# Assume MSVC wrapper
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
_LT_TAGVAR(archive_cmds, $1)='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
# The linker will automatically build a .lib file if we build a DLL.
_LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
# FIXME: Should let the user specify the lib program.
_LT_TAGVAR(old_archive_cmds, $1)='lib -OUT:$oldlib$oldobjs$old_deplibs'
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
;;
esac
;;
darwin* | rhapsody*)
_LT_DARWIN_LINKER_FEATURES($1)
;;
dgux*)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
# FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
# support. Future versions do this automatically, but an explicit c++rt0.o
# does not break anything, and helps significantly (at the cost of a little
# extra space).
freebsd2.2*)
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
# Unfortunately, older versions of FreeBSD 2 do not have this feature.
freebsd2.*)
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
# FreeBSD 3 and greater uses gcc -shared to do shared libraries.
freebsd* | dragonfly*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
hpux9*)
if test "$GCC" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared $pic_flag ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
else
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
fi
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(hardcode_direct, $1)=yes
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
;;
hpux10*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
else
_LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
fi
if test "$with_gnu_ld" = no; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
_LT_TAGVAR(hardcode_minus_L, $1)=yes
fi
;;
hpux11*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
case $host_cpu in
hppa*64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
else
case $host_cpu in
hppa*64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
m4_if($1, [], [
# Older versions of the 11.00 compiler do not understand -b yet
# (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does)
_LT_LINKER_OPTION([if $CC understands -b],
_LT_TAGVAR(lt_cv_prog_compiler__b, $1), [-b],
[_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'],
[_LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'])],
[_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'])
;;
esac
fi
if test "$with_gnu_ld" = no; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
case $host_cpu in
hppa*64*|ia64*)
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
*)
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
_LT_TAGVAR(hardcode_minus_L, $1)=yes
;;
esac
fi
;;
irix5* | irix6* | nonstopux*)
if test "$GCC" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
# Try to use the -exported_symbol ld option, if it does not
# work, assume that -exports_file does not work either and
# implicitly export all symbols.
# This should be the same for all languages, so no per-tag cache variable.
AC_CACHE_CHECK([whether the $host_os linker accepts -exported_symbol],
[lt_cv_irix_exported_symbol],
[save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null"
AC_LINK_IFELSE(
[AC_LANG_SOURCE(
[AC_LANG_CASE([C], [[int foo (void) { return 0; }]],
[C++], [[int foo (void) { return 0; }]],
[Fortran 77], [[
subroutine foo
end]],
[Fortran], [[
subroutine foo
end]])])],
[lt_cv_irix_exported_symbol=yes],
[lt_cv_irix_exported_symbol=no])
LDFLAGS="$save_LDFLAGS"])
if test "$lt_cv_irix_exported_symbol" = yes; then
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib'
fi
else
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib'
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)='no'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(inherit_rpath, $1)=yes
_LT_TAGVAR(link_all_deplibs, $1)=yes
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
else
_LT_TAGVAR(archive_cmds, $1)='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
fi
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
newsos6)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
*nto* | *qnx*)
;;
openbsd*)
if test -f /usr/libexec/ld.so; then
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
else
case $host_os in
openbsd[[01]].* | openbsd2.[[0-7]] | openbsd2.[[0-7]].*)
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
;;
esac
fi
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
os2*)
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
_LT_TAGVAR(old_archive_from_new_cmds, $1)='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
;;
osf3*)
if test "$GCC" = yes; then
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
else
_LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)='no'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
;;
osf4* | osf5*) # as osf3* with the addition of -msym flag
if test "$GCC" = yes; then
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $pic_flag $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
else
_LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
$CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp'
# Both c and cxx compiler support -rpath directly
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)='no'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
;;
solaris*)
_LT_TAGVAR(no_undefined_flag, $1)=' -z defs'
if test "$GCC" = yes; then
wlarc='${wl}'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
else
case `$CC -V 2>&1` in
*"Compilers 5.0"*)
wlarc=''
_LT_TAGVAR(archive_cmds, $1)='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
;;
*)
wlarc='${wl}'
_LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
;;
esac
fi
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
case $host_os in
solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
*)
# The compiler driver will combine and reorder linker options,
# but understands `-z linker_flag'. GCC discards it without `$wl',
# but is careful enough not to reorder.
# Supported since Solaris 2.6 (maybe 2.5.1?)
if test "$GCC" = yes; then
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
else
_LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
fi
;;
esac
_LT_TAGVAR(link_all_deplibs, $1)=yes
;;
sunos4*)
if test "x$host_vendor" = xsequent; then
# Use $CC to link under sequent, because it throws in some extra .o
# files that make .init and .fini sections work.
_LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
else
_LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
fi
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
sysv4)
case $host_vendor in
sni)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_direct, $1)=yes # is this really true???
;;
siemens)
## LD is ld it makes a PLAMLIB
## CC just makes a GrossModule.
_LT_TAGVAR(archive_cmds, $1)='$LD -G -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(reload_cmds, $1)='$CC -r -o $output$reload_objs'
_LT_TAGVAR(hardcode_direct, $1)=no
;;
motorola)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_direct, $1)=no #Motorola manual says yes, but my tests say they lie
;;
esac
runpath_var='LD_RUN_PATH'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
sysv4.3*)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(export_dynamic_flag_spec, $1)='-Bexport'
;;
sysv4*MP*)
if test -d /usr/nec; then
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
runpath_var=LD_RUN_PATH
hardcode_runpath_var=yes
_LT_TAGVAR(ld_shlibs, $1)=yes
fi
;;
sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
_LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
_LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
sysv5* | sco3.2v5* | sco5v6*)
# Note: We can NOT use -z defs as we might desire, because we do not
# link with -lc, and that would cause any symbols used from libc to
# always be unresolved, which means just about no library would
# ever link correctly. If we're not using GNU ld we use -z text
# though, which does catch some bad symbols but isn't as heavy-handed
# as -z defs.
_LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
_LT_TAGVAR(allow_undefined_flag, $1)='${wl}-z,nodefs'
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R,$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=':'
_LT_TAGVAR(link_all_deplibs, $1)=yes
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Bexport'
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
_LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
uts4*)
_LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
*)
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
if test x$host_vendor = xsni; then
case $host in
sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Blargedynsym'
;;
esac
fi
fi
])
AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
test "$_LT_TAGVAR(ld_shlibs, $1)" = no && can_build_shared=no
_LT_TAGVAR(with_gnu_ld, $1)=$with_gnu_ld
_LT_DECL([], [libext], [0], [Old archive suffix (normally "a")])dnl
_LT_DECL([], [shrext_cmds], [1], [Shared library suffix (normally ".so")])dnl
_LT_DECL([], [extract_expsyms_cmds], [2],
[The commands to extract the exported symbol list from a shared archive])
#
# Do we need to explicitly link libc?
#
case "x$_LT_TAGVAR(archive_cmds_need_lc, $1)" in
x|xyes)
# Assume -lc should be added
_LT_TAGVAR(archive_cmds_need_lc, $1)=yes
if test "$enable_shared" = yes && test "$GCC" = yes; then
case $_LT_TAGVAR(archive_cmds, $1) in
*'~'*)
# FIXME: we may have to deal with multi-command sequences.
;;
'$CC '*)
# Test whether the compiler implicitly links with -lc since on some
# systems, -lgcc has to come before -lc. If gcc already passes -lc
# to ld, don't add -lc before -lgcc.
AC_CACHE_CHECK([whether -lc should be explicitly linked in],
[lt_cv_]_LT_TAGVAR(archive_cmds_need_lc, $1),
[$RM conftest*
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
if AC_TRY_EVAL(ac_compile) 2>conftest.err; then
soname=conftest
lib=conftest
libobjs=conftest.$ac_objext
deplibs=
wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1)
pic_flag=$_LT_TAGVAR(lt_prog_compiler_pic, $1)
compiler_flags=-v
linker_flags=-v
verstring=
output_objdir=.
libname=conftest
lt_save_allow_undefined_flag=$_LT_TAGVAR(allow_undefined_flag, $1)
_LT_TAGVAR(allow_undefined_flag, $1)=
if AC_TRY_EVAL(_LT_TAGVAR(archive_cmds, $1) 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1)
then
lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=no
else
lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=yes
fi
_LT_TAGVAR(allow_undefined_flag, $1)=$lt_save_allow_undefined_flag
else
cat conftest.err 1>&5
fi
$RM conftest*
])
_LT_TAGVAR(archive_cmds_need_lc, $1)=$lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)
;;
esac
fi
;;
esac
_LT_TAGDECL([build_libtool_need_lc], [archive_cmds_need_lc], [0],
[Whether or not to add -lc for building shared libraries])
_LT_TAGDECL([allow_libtool_libs_with_static_runtimes],
[enable_shared_with_static_runtimes], [0],
[Whether or not to disallow shared libs when runtime libs are static])
_LT_TAGDECL([], [export_dynamic_flag_spec], [1],
[Compiler flag to allow reflexive dlopens])
_LT_TAGDECL([], [whole_archive_flag_spec], [1],
[Compiler flag to generate shared objects directly from archives])
_LT_TAGDECL([], [compiler_needs_object], [1],
[Whether the compiler copes with passing no objects directly])
_LT_TAGDECL([], [old_archive_from_new_cmds], [2],
[Create an old-style archive from a shared archive])
_LT_TAGDECL([], [old_archive_from_expsyms_cmds], [2],
[Create a temporary old-style archive to link instead of a shared archive])
_LT_TAGDECL([], [archive_cmds], [2], [Commands used to build a shared archive])
_LT_TAGDECL([], [archive_expsym_cmds], [2])
_LT_TAGDECL([], [module_cmds], [2],
[Commands used to build a loadable module if different from building
a shared archive.])
_LT_TAGDECL([], [module_expsym_cmds], [2])
_LT_TAGDECL([], [with_gnu_ld], [1],
[Whether we are building with GNU ld or not])
_LT_TAGDECL([], [allow_undefined_flag], [1],
[Flag that allows shared libraries with undefined symbols to be built])
_LT_TAGDECL([], [no_undefined_flag], [1],
[Flag that enforces no undefined symbols])
_LT_TAGDECL([], [hardcode_libdir_flag_spec], [1],
[Flag to hardcode $libdir into a binary during linking.
This must work even if $libdir does not exist])
_LT_TAGDECL([], [hardcode_libdir_separator], [1],
[Whether we need a single "-rpath" flag with a separated argument])
_LT_TAGDECL([], [hardcode_direct], [0],
[Set to "yes" if using DIR/libNAME${shared_ext} during linking hardcodes
DIR into the resulting binary])
_LT_TAGDECL([], [hardcode_direct_absolute], [0],
[Set to "yes" if using DIR/libNAME${shared_ext} during linking hardcodes
DIR into the resulting binary and the resulting library dependency is
"absolute", i.e impossible to change by setting ${shlibpath_var} if the
library is relocated])
_LT_TAGDECL([], [hardcode_minus_L], [0],
[Set to "yes" if using the -LDIR flag during linking hardcodes DIR
into the resulting binary])
_LT_TAGDECL([], [hardcode_shlibpath_var], [0],
[Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
into the resulting binary])
_LT_TAGDECL([], [hardcode_automatic], [0],
[Set to "yes" if building a shared library automatically hardcodes DIR
into the library and all subsequent libraries and executables linked
against it])
_LT_TAGDECL([], [inherit_rpath], [0],
[Set to yes if linker adds runtime paths of dependent libraries
to runtime path list])
_LT_TAGDECL([], [link_all_deplibs], [0],
[Whether libtool must link a program against all its dependency libraries])
_LT_TAGDECL([], [always_export_symbols], [0],
[Set to "yes" if exported symbols are required])
_LT_TAGDECL([], [export_symbols_cmds], [2],
[The commands to list exported symbols])
_LT_TAGDECL([], [exclude_expsyms], [1],
[Symbols that should not be listed in the preloaded symbols])
_LT_TAGDECL([], [include_expsyms], [1],
[Symbols that must always be exported])
_LT_TAGDECL([], [prelink_cmds], [2],
[Commands necessary for linking programs (against libraries) with templates])
_LT_TAGDECL([], [postlink_cmds], [2],
[Commands necessary for finishing linking programs])
_LT_TAGDECL([], [file_list_spec], [1],
[Specify filename containing input files])
dnl FIXME: Not yet implemented
dnl _LT_TAGDECL([], [thread_safe_flag_spec], [1],
dnl [Compiler flag to generate thread safe objects])
])# _LT_LINKER_SHLIBS
# _LT_LANG_C_CONFIG([TAG])
# ------------------------
# Ensure that the configuration variables for a C compiler are suitably
# defined. These variables are subsequently used by _LT_CONFIG to write
# the compiler configuration to `libtool'.
m4_defun([_LT_LANG_C_CONFIG],
[m4_require([_LT_DECL_EGREP])dnl
lt_save_CC="$CC"
AC_LANG_PUSH(C)
# Source file extension for C test sources.
ac_ext=c
# Object file extension for compiled C test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# Code to be used in simple compile tests
lt_simple_compile_test_code="int some_variable = 0;"
# Code to be used in simple link tests
lt_simple_link_test_code='int main(){return(0);}'
_LT_TAG_COMPILER
# Save the default compiler, since it gets overwritten when the other
# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
compiler_DEFAULT=$CC
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
if test -n "$compiler"; then
_LT_COMPILER_NO_RTTI($1)
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_SYS_DYNAMIC_LINKER($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
LT_SYS_DLOPEN_SELF
_LT_CMD_STRIPLIB
# Report which library types will actually be built
AC_MSG_CHECKING([if libtool supports shared libraries])
AC_MSG_RESULT([$can_build_shared])
AC_MSG_CHECKING([whether to build shared libraries])
test "$can_build_shared" = "no" && enable_shared=no
# On AIX, shared libraries and static libraries use the same namespace, and
# are all built from PIC.
case $host_os in
aix3*)
test "$enable_shared" = yes && enable_static=no
if test -n "$RANLIB"; then
archive_cmds="$archive_cmds~\$RANLIB \$lib"
postinstall_cmds='$RANLIB $lib'
fi
;;
aix[[4-9]]*)
if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
test "$enable_shared" = yes && enable_static=no
fi
;;
esac
AC_MSG_RESULT([$enable_shared])
AC_MSG_CHECKING([whether to build static libraries])
# Make sure either enable_shared or enable_static is yes.
test "$enable_shared" = yes || enable_static=yes
AC_MSG_RESULT([$enable_static])
_LT_CONFIG($1)
fi
AC_LANG_POP
CC="$lt_save_CC"
])# _LT_LANG_C_CONFIG
# _LT_LANG_CXX_CONFIG([TAG])
# --------------------------
# Ensure that the configuration variables for a C++ compiler are suitably
# defined. These variables are subsequently used by _LT_CONFIG to write
# the compiler configuration to `libtool'.
m4_defun([_LT_LANG_CXX_CONFIG],
[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
m4_require([_LT_DECL_EGREP])dnl
m4_require([_LT_PATH_MANIFEST_TOOL])dnl
if test -n "$CXX" && ( test "X$CXX" != "Xno" &&
( (test "X$CXX" = "Xg++" && `g++ -v >/dev/null 2>&1` ) ||
(test "X$CXX" != "Xg++"))) ; then
AC_PROG_CXXCPP
else
_lt_caught_CXX_error=yes
fi
AC_LANG_PUSH(C++)
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(allow_undefined_flag, $1)=
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(archive_expsym_cmds, $1)=
_LT_TAGVAR(compiler_needs_object, $1)=no
_LT_TAGVAR(export_dynamic_flag_spec, $1)=
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
_LT_TAGVAR(hardcode_libdir_separator, $1)=
_LT_TAGVAR(hardcode_minus_L, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported
_LT_TAGVAR(hardcode_automatic, $1)=no
_LT_TAGVAR(inherit_rpath, $1)=no
_LT_TAGVAR(module_cmds, $1)=
_LT_TAGVAR(module_expsym_cmds, $1)=
_LT_TAGVAR(link_all_deplibs, $1)=unknown
_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
_LT_TAGVAR(reload_flag, $1)=$reload_flag
_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
_LT_TAGVAR(no_undefined_flag, $1)=
_LT_TAGVAR(whole_archive_flag_spec, $1)=
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
# Source file extension for C++ test sources.
ac_ext=cpp
# Object file extension for compiled C++ test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# No sense in running all these tests if we already determined that
# the CXX compiler isn't working. Some variables (like enable_shared)
# are currently assumed to apply to all compilers on this platform,
# and will be corrupted by setting them based on a non-working compiler.
if test "$_lt_caught_CXX_error" != yes; then
# Code to be used in simple compile tests
lt_simple_compile_test_code="int some_variable = 0;"
# Code to be used in simple link tests
lt_simple_link_test_code='int main(int, char *[[]]) { return(0); }'
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC=$CC
lt_save_CFLAGS=$CFLAGS
lt_save_LD=$LD
lt_save_GCC=$GCC
GCC=$GXX
lt_save_with_gnu_ld=$with_gnu_ld
lt_save_path_LD=$lt_cv_path_LD
if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then
lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx
else
$as_unset lt_cv_prog_gnu_ld
fi
if test -n "${lt_cv_path_LDCXX+set}"; then
lt_cv_path_LD=$lt_cv_path_LDCXX
else
$as_unset lt_cv_path_LD
fi
test -z "${LDCXX+set}" || LD=$LDCXX
CC=${CXX-"c++"}
CFLAGS=$CXXFLAGS
compiler=$CC
_LT_TAGVAR(compiler, $1)=$CC
_LT_CC_BASENAME([$compiler])
if test -n "$compiler"; then
# We don't want -fno-exception when compiling C++ code, so set the
# no_builtin_flag separately
if test "$GXX" = yes; then
_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin'
else
_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=
fi
if test "$GXX" = yes; then
# Set up default GNU C++ configuration
LT_PATH_LD
# Check if GNU C++ uses GNU ld as the underlying linker, since the
# archiving commands below assume that GNU ld is being used.
if test "$with_gnu_ld" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
# If archive_cmds runs LD, not CC, wlarc should be empty
# XXX I think wlarc can be eliminated in ltcf-cxx, but I need to
# investigate it a little bit more. (MM)
wlarc='${wl}'
# ancient GNU ld didn't support --whole-archive et. al.
if eval "`$CC -print-prog-name=ld` --help 2>&1" |
$GREP 'no-whole-archive' > /dev/null; then
_LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
else
_LT_TAGVAR(whole_archive_flag_spec, $1)=
fi
else
with_gnu_ld=no
wlarc=
# A generic and very simple default shared library creation
# command for GNU C++ for the case where it uses the native
# linker, instead of GNU ld. If possible, this setting should
# overridden to take advantage of the native linker features on
# the platform it is being used on.
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
fi
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
else
GXX=no
with_gnu_ld=no
wlarc=
fi
# PORTME: fill in a description of your system's C++ link characteristics
AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries])
_LT_TAGVAR(ld_shlibs, $1)=yes
case $host_os in
aix3*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
aix[[4-9]]*)
if test "$host_cpu" = ia64; then
# On IA64, the linker does run time linking by default, so we don't
# have to do anything special.
aix_use_runtimelinking=no
exp_sym_flag='-Bexport'
no_entry_flag=""
else
aix_use_runtimelinking=no
# Test if we are trying to use run time linking or normal
# AIX style linking. If -brtl is somewhere in LDFLAGS, we
# need to do runtime linking.
case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*)
for ld_flag in $LDFLAGS; do
case $ld_flag in
*-brtl*)
aix_use_runtimelinking=yes
break
;;
esac
done
;;
esac
exp_sym_flag='-bexport'
no_entry_flag='-bnoentry'
fi
# When large executables or shared objects are built, AIX ld can
# have problems creating the table of contents. If linking a library
# or program results in "error TOC overflow" add -mminimal-toc to
# CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
# enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
_LT_TAGVAR(archive_cmds, $1)=''
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(hardcode_libdir_separator, $1)=':'
_LT_TAGVAR(link_all_deplibs, $1)=yes
_LT_TAGVAR(file_list_spec, $1)='${wl}-f,'
if test "$GXX" = yes; then
case $host_os in aix4.[[012]]|aix4.[[012]].*)
# We only want to do this on AIX 4.2 and lower, the check
# below for broken collect2 doesn't work under 4.3+
collect2name=`${CC} -print-prog-name=collect2`
if test -f "$collect2name" &&
strings "$collect2name" | $GREP resolve_lib_name >/dev/null
then
# We have reworked collect2
:
else
# We have old collect2
_LT_TAGVAR(hardcode_direct, $1)=unsupported
# It fails to find uninstalled libraries when the uninstalled
# path is not listed in the libpath. Setting hardcode_minus_L
# to unsupported forces relinking
_LT_TAGVAR(hardcode_minus_L, $1)=yes
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=
fi
esac
shared_flag='-shared'
if test "$aix_use_runtimelinking" = yes; then
shared_flag="$shared_flag "'${wl}-G'
fi
else
# not using gcc
if test "$host_cpu" = ia64; then
# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
# chokes on -Wl,-G. The following line is correct:
shared_flag='-G'
else
if test "$aix_use_runtimelinking" = yes; then
shared_flag='${wl}-G'
else
shared_flag='${wl}-bM:SRE'
fi
fi
fi
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-bexpall'
# It seems that -bexpall does not export symbols beginning with
# underscore (_), so it is better to generate a list of symbols to
# export.
_LT_TAGVAR(always_export_symbols, $1)=yes
if test "$aix_use_runtimelinking" = yes; then
# Warning - without using the other runtime loading flags (-brtl),
# -berok will link without error, but may produce a broken library.
_LT_TAGVAR(allow_undefined_flag, $1)='-berok'
# Determine the default libpath from the value encoded in an empty
# executable.
_LT_SYS_MODULE_PATH_AIX([$1])
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
else
if test "$host_cpu" = ia64; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $libdir:/usr/lib:/lib'
_LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs"
_LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
else
# Determine the default libpath from the value encoded in an
# empty executable.
_LT_SYS_MODULE_PATH_AIX([$1])
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-blibpath:$libdir:'"$aix_libpath"
# Warning - without using the other run time loading flags,
# -berok will link without error, but may produce a broken library.
_LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-bernotok'
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-berok'
if test "$with_gnu_ld" = yes; then
# We only use this code for GNU lds that support --whole-archive.
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
else
# Exported symbols can be pulled into shared objects from archives
_LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience'
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)=yes
# This is similar to how AIX traditionally builds its shared
# libraries.
_LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
fi
fi
;;
beos*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
# Joseph Beckenbach says some releases of gcc
# support --undefined. This deserves some investigation. FIXME
_LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
chorus*)
case $cc_basename in
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
;;
cygwin* | mingw* | pw32* | cegcc*)
case $GXX,$cc_basename in
,cl* | no,cl*)
# Native MSVC
# hardcode_libdir_flag_spec is actually meaningless, as there is
# no search path for DLLs.
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' '
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(always_export_symbols, $1)=yes
_LT_TAGVAR(file_list_spec, $1)='@'
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
_LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-dll~linknames='
_LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
$SED -n -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' -e '1\\\!p' < $export_symbols > $output_objdir/$soname.exp;
else
$SED -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' < $export_symbols > $output_objdir/$soname.exp;
fi~
$CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
linknames='
# The linker will not automatically build a static lib if we build a DLL.
# _LT_TAGVAR(old_archive_from_new_cmds, $1)='true'
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
# Don't use ranlib
_LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib'
_LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~
lt_tool_outputfile="@TOOL_OUTPUT@"~
case $lt_outputfile in
*.exe|*.EXE) ;;
*)
lt_outputfile="$lt_outputfile.exe"
lt_tool_outputfile="$lt_tool_outputfile.exe"
;;
esac~
func_to_tool_file "$lt_outputfile"~
if test "$MANIFEST_TOOL" != ":" && test -f "$lt_outputfile.manifest"; then
$MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
$RM "$lt_outputfile.manifest";
fi'
;;
*)
# g++
# _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless,
# as there is no search path for DLLs.
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-all-symbols'
_LT_TAGVAR(allow_undefined_flag, $1)=unsupported
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes
if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
# If the export-symbols file already is a .def file (1st line
# is EXPORTS), use it as is; otherwise, prepend...
_LT_TAGVAR(archive_expsym_cmds, $1)='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
cp $export_symbols $output_objdir/$soname.def;
else
echo EXPORTS > $output_objdir/$soname.def;
cat $export_symbols >> $output_objdir/$soname.def;
fi~
$CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
;;
darwin* | rhapsody*)
_LT_DARWIN_LINKER_FEATURES($1)
;;
dgux*)
case $cc_basename in
ec++*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
ghcx*)
# Green Hills C++ Compiler
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
;;
freebsd2.*)
# C++ shared libraries reported to be fairly broken before
# switch to ELF
_LT_TAGVAR(ld_shlibs, $1)=no
;;
freebsd-elf*)
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
;;
freebsd* | dragonfly*)
# FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF
# conventions
_LT_TAGVAR(ld_shlibs, $1)=yes
;;
gnu*)
;;
haiku*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(link_all_deplibs, $1)=yes
;;
hpux9*)
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
# but as the default
# location of the library.
case $cc_basename in
CC*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
aCC*)
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -b ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
#
# There doesn't appear to be a way to prevent this compiler from
# explicitly linking system object files so we need to strip them
# from the output so that they don't get included in the library
# dependencies.
output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
;;
*)
if test "$GXX" = yes; then
_LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared -nostdlib $pic_flag ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
else
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
;;
hpux10*|hpux11*)
if test $with_gnu_ld = no; then
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}+b ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
case $host_cpu in
hppa*64*|ia64*)
;;
*)
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
;;
esac
fi
case $host_cpu in
hppa*64*|ia64*)
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
;;
*)
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH,
# but as the default
# location of the library.
;;
esac
case $cc_basename in
CC*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
aCC*)
case $host_cpu in
hppa*64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
ia64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
esac
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
#
# There doesn't appear to be a way to prevent this compiler from
# explicitly linking system object files so we need to strip them
# from the output so that they don't get included in the library
# dependencies.
output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
;;
*)
if test "$GXX" = yes; then
if test $with_gnu_ld = no; then
case $host_cpu in
hppa*64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC ${wl}+h ${wl}$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
ia64*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
;;
esac
fi
else
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
;;
interix[[3-9]]*)
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
# Instead, shared libraries are loaded at an image base (0x10000000 by
# default) and relocated if they conflict, which is a slow very memory
# consuming and fragmenting process. To avoid this, we pick a random,
# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
# time. Moving up from 0x10000000 also allows more sbrk(2) space.
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
irix5* | irix6*)
case $cc_basename in
CC*)
# SGI C++
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
# Archives containing C++ object files must be created using
# "CC -ar", where "CC" is the IRIX C++ compiler. This is
# necessary to make sure instantiated templates are included
# in the archive.
_LT_TAGVAR(old_archive_cmds, $1)='$CC -ar -WR,-u -o $oldlib $oldobjs'
;;
*)
if test "$GXX" = yes; then
if test "$with_gnu_ld" = no; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
else
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` -o $lib'
fi
fi
_LT_TAGVAR(link_all_deplibs, $1)=yes
;;
esac
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
_LT_TAGVAR(inherit_rpath, $1)=yes
;;
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
KCC*)
# Kuck and Associates, Inc. (KAI) C++ Compiler
# KCC will only create a shared library if the output file
# ends with ".so" (or ".sl" for HP-UX), so rename the library
# to its proper name (with version) after linking.
_LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib ${wl}-retain-symbols-file,$export_symbols; mv \$templib $lib'
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
#
# There doesn't appear to be a way to prevent this compiler from
# explicitly linking system object files so we need to strip them
# from the output so that they don't get included in the library
# dependencies.
output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
# Archives containing C++ object files must be created using
# "CC -Bstatic", where "CC" is the KAI C++ compiler.
_LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs'
;;
icpc* | ecpc* )
# Intel C++
with_gnu_ld=yes
# version 8.0 and above of icpc choke on multiply defined symbols
# if we add $predep_objects and $postdep_objects, however 7.1 and
# earlier do not add the objects themselves.
case `$CC -V 2>&1` in
*"Version 7."*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
;;
*) # Version 8.0 or newer
tmp_idyn=
case $host_cpu in
ia64*) tmp_idyn=' -i_dynamic';;
esac
_LT_TAGVAR(archive_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
;;
esac
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
;;
pgCC* | pgcpp*)
# Portland Group C++ compiler
case `$CC -V` in
*pgCC\ [[1-5]].* | *pgcpp\ [[1-5]].*)
_LT_TAGVAR(prelink_cmds, $1)='tpldir=Template.dir~
rm -rf $tpldir~
$CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~
compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"'
_LT_TAGVAR(old_archive_cmds, $1)='tpldir=Template.dir~
rm -rf $tpldir~
$CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~
$AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~
$RANLIB $oldlib'
_LT_TAGVAR(archive_cmds, $1)='tpldir=Template.dir~
rm -rf $tpldir~
$CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
$CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='tpldir=Template.dir~
rm -rf $tpldir~
$CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~
$CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
;;
*) # Version 6 and above use weak symbols
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname ${wl}-retain-symbols-file ${wl}$export_symbols -o $lib'
;;
esac
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}--rpath ${wl}$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
;;
cxx*)
# Compaq C++
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $wl$soname -o $lib ${wl}-retain-symbols-file $wl$export_symbols'
runpath_var=LD_RUN_PATH
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
#
# There doesn't appear to be a way to prevent this compiler from
# explicitly linking system object files so we need to strip them
# from the output so that they don't get included in the library
# dependencies.
output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed'
;;
xl* | mpixl* | bgxl*)
# IBM XL 8.0 on PPC, with GNU ld
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}--export-dynamic'
_LT_TAGVAR(archive_cmds, $1)='$CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$CC -qmkshrobj $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
fi
;;
*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*)
# Sun C++ 5.9
_LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
_LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file ${wl}$export_symbols'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
_LT_TAGVAR(compiler_needs_object, $1)=yes
# Not sure whether something based on
# $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1
# would be better.
output_verbose_link_cmd='func_echo_all'
# Archives containing C++ object files must be created using
# "CC -xar", where "CC" is the Sun C++ compiler. This is
# necessary to make sure instantiated templates are included
# in the archive.
_LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
;;
esac
;;
esac
;;
lynxos*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
m88k*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
mvs*)
case $cc_basename in
cxx*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags'
wlarc=
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
fi
# Workaround some broken pre-1.5 toolchains
output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"'
;;
*nto* | *qnx*)
_LT_TAGVAR(ld_shlibs, $1)=yes
;;
openbsd2*)
# C++ shared libraries are fairly broken
_LT_TAGVAR(ld_shlibs, $1)=no
;;
openbsd*)
if test -f /usr/libexec/ld.so; then
_LT_TAGVAR(hardcode_direct, $1)=yes
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=yes
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-retain-symbols-file,$export_symbols -o $lib'
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-E'
_LT_TAGVAR(whole_archive_flag_spec, $1)="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
fi
output_verbose_link_cmd=func_echo_all
else
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
osf3* | osf4* | osf5*)
case $cc_basename in
KCC*)
# Kuck and Associates, Inc. (KAI) C++ Compiler
# KCC will only create a shared library if the output file
# ends with ".so" (or ".sl" for HP-UX), so rename the library
# to its proper name (with version) after linking.
_LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\${tempext}\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath,$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
# Archives containing C++ object files must be created using
# the KAI C++ compiler.
case $host in
osf3*) _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs' ;;
*) _LT_TAGVAR(old_archive_cmds, $1)='$CC -o $oldlib $oldobjs' ;;
esac
;;
RCC*)
# Rational C++ 2.4.1
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
cxx*)
case $host in
osf3*)
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname $soname `test -n "$verstring" && func_echo_all "${wl}-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
;;
*)
_LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*'
_LT_TAGVAR(archive_cmds, $1)='$CC -shared${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~
echo "-hidden">> $lib.exp~
$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname ${wl}-input ${wl}$lib.exp `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~
$RM $lib.exp'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir'
;;
esac
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
#
# There doesn't appear to be a way to prevent this compiler from
# explicitly linking system object files so we need to strip them
# from the output so that they don't get included in the library
# dependencies.
output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list=""; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"'
;;
*)
if test "$GXX" = yes && test "$with_gnu_ld" = no; then
_LT_TAGVAR(allow_undefined_flag, $1)=' ${wl}-expect_unresolved ${wl}\*'
case $host in
osf3*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib ${allow_undefined_flag} $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
;;
esac
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-rpath ${wl}$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=:
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
else
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
fi
;;
esac
;;
psos*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
sunos4*)
case $cc_basename in
CC*)
# Sun C++ 4.x
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
lcc*)
# Lucid
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
;;
solaris*)
case $cc_basename in
CC* | sunCC*)
# Sun C++ 4.2, 5.x and Centerline C++
_LT_TAGVAR(archive_cmds_need_lc,$1)=yes
_LT_TAGVAR(no_undefined_flag, $1)=' -zdefs'
_LT_TAGVAR(archive_cmds, $1)='$CC -G${allow_undefined_flag} -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -G${allow_undefined_flag} ${wl}-M ${wl}$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir'
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
case $host_os in
solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
*)
# The compiler driver will combine and reorder linker options,
# but understands `-z linker_flag'.
# Supported since Solaris 2.6 (maybe 2.5.1?)
_LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract'
;;
esac
_LT_TAGVAR(link_all_deplibs, $1)=yes
output_verbose_link_cmd='func_echo_all'
# Archives containing C++ object files must be created using
# "CC -xar", where "CC" is the Sun C++ compiler. This is
# necessary to make sure instantiated templates are included
# in the archive.
_LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs'
;;
gcx*)
# Green Hills C++ Compiler
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
# The C++ compiler must be used to create the archive.
_LT_TAGVAR(old_archive_cmds, $1)='$CC $LDFLAGS -archive -o $oldlib $oldobjs'
;;
*)
# GNU C++ compiler with Solaris linker
if test "$GXX" = yes && test "$with_gnu_ld" = no; then
_LT_TAGVAR(no_undefined_flag, $1)=' ${wl}-z ${wl}defs'
if $CC --version | $GREP -v '^2\.7' > /dev/null; then
_LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -shared $pic_flag -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
else
# g++ 2.7 appears to require `-G' NOT `-shared' on this
# platform.
_LT_TAGVAR(archive_cmds, $1)='$CC -G -nostdlib $LDFLAGS $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags ${wl}-h $wl$soname -o $lib'
_LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -G -nostdlib ${wl}-M $wl$lib.exp -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp'
# Commands to make compiler produce verbose output that lists
# what "hidden" libraries, object files and flags are used when
# linking a shared library.
output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"'
fi
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R $wl$libdir'
case $host_os in
solaris2.[[0-5]] | solaris2.[[0-5]].*) ;;
*)
_LT_TAGVAR(whole_archive_flag_spec, $1)='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
;;
esac
fi
;;
esac
;;
sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*)
_LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
runpath_var='LD_RUN_PATH'
case $cc_basename in
CC*)
_LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
;;
sysv5* | sco3.2v5* | sco5v6*)
# Note: We can NOT use -z defs as we might desire, because we do not
# link with -lc, and that would cause any symbols used from libc to
# always be unresolved, which means just about no library would
# ever link correctly. If we're not using GNU ld we use -z text
# though, which does catch some bad symbols but isn't as heavy-handed
# as -z defs.
_LT_TAGVAR(no_undefined_flag, $1)='${wl}-z,text'
_LT_TAGVAR(allow_undefined_flag, $1)='${wl}-z,nodefs'
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(hardcode_shlibpath_var, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)='${wl}-R,$libdir'
_LT_TAGVAR(hardcode_libdir_separator, $1)=':'
_LT_TAGVAR(link_all_deplibs, $1)=yes
_LT_TAGVAR(export_dynamic_flag_spec, $1)='${wl}-Bexport'
runpath_var='LD_RUN_PATH'
case $cc_basename in
CC*)
_LT_TAGVAR(archive_cmds, $1)='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(old_archive_cmds, $1)='$CC -Tprelink_objects $oldobjs~
'"$_LT_TAGVAR(old_archive_cmds, $1)"
_LT_TAGVAR(reload_cmds, $1)='$CC -Tprelink_objects $reload_objs~
'"$_LT_TAGVAR(reload_cmds, $1)"
;;
*)
_LT_TAGVAR(archive_cmds, $1)='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
_LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
;;
tandem*)
case $cc_basename in
NCC*)
# NonStop-UX NCC 3.20
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
;;
vxworks*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
*)
# FIXME: insert proper C++ library support
_LT_TAGVAR(ld_shlibs, $1)=no
;;
esac
AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)])
test "$_LT_TAGVAR(ld_shlibs, $1)" = no && can_build_shared=no
_LT_TAGVAR(GCC, $1)="$GXX"
_LT_TAGVAR(LD, $1)="$LD"
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
_LT_SYS_HIDDEN_LIBDEPS($1)
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_SYS_DYNAMIC_LINKER($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
_LT_CONFIG($1)
fi # test -n "$compiler"
CC=$lt_save_CC
CFLAGS=$lt_save_CFLAGS
LDCXX=$LD
LD=$lt_save_LD
GCC=$lt_save_GCC
with_gnu_ld=$lt_save_with_gnu_ld
lt_cv_path_LDCXX=$lt_cv_path_LD
lt_cv_path_LD=$lt_save_path_LD
lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld
lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld
fi # test "$_lt_caught_CXX_error" != yes
AC_LANG_POP
])# _LT_LANG_CXX_CONFIG
# _LT_FUNC_STRIPNAME_CNF
# ----------------------
# func_stripname_cnf prefix suffix name
# strip PREFIX and SUFFIX off of NAME.
# PREFIX and SUFFIX must not contain globbing or regex special
# characters, hashes, percent signs, but SUFFIX may contain a leading
# dot (in which case that matches only a dot).
#
# This function is identical to the (non-XSI) version of func_stripname,
# except this one can be used by m4 code that may be executed by configure,
# rather than the libtool script.
m4_defun([_LT_FUNC_STRIPNAME_CNF],[dnl
AC_REQUIRE([_LT_DECL_SED])
AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])
func_stripname_cnf ()
{
case ${2} in
.*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;;
*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;;
esac
} # func_stripname_cnf
])# _LT_FUNC_STRIPNAME_CNF
# _LT_SYS_HIDDEN_LIBDEPS([TAGNAME])
# ---------------------------------
# Figure out "hidden" library dependencies from verbose
# compiler output when linking a shared library.
# Parse the compiler output and extract the necessary
# objects, libraries and library flags.
m4_defun([_LT_SYS_HIDDEN_LIBDEPS],
[m4_require([_LT_FILEUTILS_DEFAULTS])dnl
AC_REQUIRE([_LT_FUNC_STRIPNAME_CNF])dnl
# Dependencies to place before and after the object being linked:
_LT_TAGVAR(predep_objects, $1)=
_LT_TAGVAR(postdep_objects, $1)=
_LT_TAGVAR(predeps, $1)=
_LT_TAGVAR(postdeps, $1)=
_LT_TAGVAR(compiler_lib_search_path, $1)=
dnl we can't use the lt_simple_compile_test_code here,
dnl because it contains code intended for an executable,
dnl not a library. It's possible we should let each
dnl tag define a new lt_????_link_test_code variable,
dnl but it's only used here...
m4_if([$1], [], [cat > conftest.$ac_ext <<_LT_EOF
int a;
void foo (void) { a = 0; }
_LT_EOF
], [$1], [CXX], [cat > conftest.$ac_ext <<_LT_EOF
class Foo
{
public:
Foo (void) { a = 0; }
private:
int a;
};
_LT_EOF
], [$1], [F77], [cat > conftest.$ac_ext <<_LT_EOF
subroutine foo
implicit none
integer*4 a
a=0
return
end
_LT_EOF
], [$1], [FC], [cat > conftest.$ac_ext <<_LT_EOF
subroutine foo
implicit none
integer a
a=0
return
end
_LT_EOF
], [$1], [GCJ], [cat > conftest.$ac_ext <<_LT_EOF
public class foo {
private int a;
public void bar (void) {
a = 0;
}
};
_LT_EOF
], [$1], [GO], [cat > conftest.$ac_ext <<_LT_EOF
package foo
func foo() {
}
_LT_EOF
])
_lt_libdeps_save_CFLAGS=$CFLAGS
case "$CC $CFLAGS " in #(
*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;;
*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;;
*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;;
esac
dnl Parse the compiler output and extract the necessary
dnl objects, libraries and library flags.
if AC_TRY_EVAL(ac_compile); then
# Parse the compiler output and extract the necessary
# objects, libraries and library flags.
# Sentinel used to keep track of whether or not we are before
# the conftest object file.
pre_test_object_deps_done=no
for p in `eval "$output_verbose_link_cmd"`; do
case ${prev}${p} in
-L* | -R* | -l*)
# Some compilers place space between "-{L,R}" and the path.
# Remove the space.
if test $p = "-L" ||
test $p = "-R"; then
prev=$p
continue
fi
# Expand the sysroot to ease extracting the directories later.
if test -z "$prev"; then
case $p in
-L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;;
-R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;;
-l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;;
esac
fi
case $p in
=*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;;
esac
if test "$pre_test_object_deps_done" = no; then
case ${prev} in
-L | -R)
# Internal compiler library paths should come after those
# provided the user. The postdeps already come after the
# user supplied libs so there is no need to process them.
if test -z "$_LT_TAGVAR(compiler_lib_search_path, $1)"; then
_LT_TAGVAR(compiler_lib_search_path, $1)="${prev}${p}"
else
_LT_TAGVAR(compiler_lib_search_path, $1)="${_LT_TAGVAR(compiler_lib_search_path, $1)} ${prev}${p}"
fi
;;
# The "-l" case would never come before the object being
# linked, so don't bother handling this case.
esac
else
if test -z "$_LT_TAGVAR(postdeps, $1)"; then
_LT_TAGVAR(postdeps, $1)="${prev}${p}"
else
_LT_TAGVAR(postdeps, $1)="${_LT_TAGVAR(postdeps, $1)} ${prev}${p}"
fi
fi
prev=
;;
*.lto.$objext) ;; # Ignore GCC LTO objects
*.$objext)
# This assumes that the test object file only shows up
# once in the compiler output.
if test "$p" = "conftest.$objext"; then
pre_test_object_deps_done=yes
continue
fi
if test "$pre_test_object_deps_done" = no; then
if test -z "$_LT_TAGVAR(predep_objects, $1)"; then
_LT_TAGVAR(predep_objects, $1)="$p"
else
_LT_TAGVAR(predep_objects, $1)="$_LT_TAGVAR(predep_objects, $1) $p"
fi
else
if test -z "$_LT_TAGVAR(postdep_objects, $1)"; then
_LT_TAGVAR(postdep_objects, $1)="$p"
else
_LT_TAGVAR(postdep_objects, $1)="$_LT_TAGVAR(postdep_objects, $1) $p"
fi
fi
;;
*) ;; # Ignore the rest.
esac
done
# Clean up.
rm -f a.out a.exe
else
echo "libtool.m4: error: problem compiling $1 test program"
fi
$RM -f confest.$objext
CFLAGS=$_lt_libdeps_save_CFLAGS
# PORTME: override above test on systems where it is broken
m4_if([$1], [CXX],
[case $host_os in
interix[[3-9]]*)
# Interix 3.5 installs completely hosed .la files for C++, so rather than
# hack all around it, let's just trust "g++" to DTRT.
_LT_TAGVAR(predep_objects,$1)=
_LT_TAGVAR(postdep_objects,$1)=
_LT_TAGVAR(postdeps,$1)=
;;
linux*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*)
# Sun C++ 5.9
# The more standards-conforming stlport4 library is
# incompatible with the Cstd library. Avoid specifying
# it if it's in CXXFLAGS. Ignore libCrun as
# -library=stlport4 depends on it.
case " $CXX $CXXFLAGS " in
*" -library=stlport4 "*)
solaris_use_stlport4=yes
;;
esac
if test "$solaris_use_stlport4" != yes; then
_LT_TAGVAR(postdeps,$1)='-library=Cstd -library=Crun'
fi
;;
esac
;;
solaris*)
case $cc_basename in
CC* | sunCC*)
# The more standards-conforming stlport4 library is
# incompatible with the Cstd library. Avoid specifying
# it if it's in CXXFLAGS. Ignore libCrun as
# -library=stlport4 depends on it.
case " $CXX $CXXFLAGS " in
*" -library=stlport4 "*)
solaris_use_stlport4=yes
;;
esac
# Adding this requires a known-good setup of shared libraries for
# Sun compiler versions before 5.6, else PIC objects from an old
# archive will be linked into the output, leading to subtle bugs.
if test "$solaris_use_stlport4" != yes; then
_LT_TAGVAR(postdeps,$1)='-library=Cstd -library=Crun'
fi
;;
esac
;;
esac
])
case " $_LT_TAGVAR(postdeps, $1) " in
*" -lc "*) _LT_TAGVAR(archive_cmds_need_lc, $1)=no ;;
esac
_LT_TAGVAR(compiler_lib_search_dirs, $1)=
if test -n "${_LT_TAGVAR(compiler_lib_search_path, $1)}"; then
_LT_TAGVAR(compiler_lib_search_dirs, $1)=`echo " ${_LT_TAGVAR(compiler_lib_search_path, $1)}" | ${SED} -e 's! -L! !g' -e 's!^ !!'`
fi
_LT_TAGDECL([], [compiler_lib_search_dirs], [1],
[The directories searched by this compiler when creating a shared library])
_LT_TAGDECL([], [predep_objects], [1],
[Dependencies to place before and after the objects being linked to
create a shared library])
_LT_TAGDECL([], [postdep_objects], [1])
_LT_TAGDECL([], [predeps], [1])
_LT_TAGDECL([], [postdeps], [1])
_LT_TAGDECL([], [compiler_lib_search_path], [1],
[The library search path used internally by the compiler when linking
a shared library])
])# _LT_SYS_HIDDEN_LIBDEPS
# _LT_LANG_F77_CONFIG([TAG])
# --------------------------
# Ensure that the configuration variables for a Fortran 77 compiler are
# suitably defined. These variables are subsequently used by _LT_CONFIG
# to write the compiler configuration to `libtool'.
m4_defun([_LT_LANG_F77_CONFIG],
[AC_LANG_PUSH(Fortran 77)
if test -z "$F77" || test "X$F77" = "Xno"; then
_lt_disable_F77=yes
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(allow_undefined_flag, $1)=
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(archive_expsym_cmds, $1)=
_LT_TAGVAR(export_dynamic_flag_spec, $1)=
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
_LT_TAGVAR(hardcode_libdir_separator, $1)=
_LT_TAGVAR(hardcode_minus_L, $1)=no
_LT_TAGVAR(hardcode_automatic, $1)=no
_LT_TAGVAR(inherit_rpath, $1)=no
_LT_TAGVAR(module_cmds, $1)=
_LT_TAGVAR(module_expsym_cmds, $1)=
_LT_TAGVAR(link_all_deplibs, $1)=unknown
_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
_LT_TAGVAR(reload_flag, $1)=$reload_flag
_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
_LT_TAGVAR(no_undefined_flag, $1)=
_LT_TAGVAR(whole_archive_flag_spec, $1)=
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
# Source file extension for f77 test sources.
ac_ext=f
# Object file extension for compiled f77 test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# No sense in running all these tests if we already determined that
# the F77 compiler isn't working. Some variables (like enable_shared)
# are currently assumed to apply to all compilers on this platform,
# and will be corrupted by setting them based on a non-working compiler.
if test "$_lt_disable_F77" != yes; then
# Code to be used in simple compile tests
lt_simple_compile_test_code="\
subroutine t
return
end
"
# Code to be used in simple link tests
lt_simple_link_test_code="\
program t
end
"
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC="$CC"
lt_save_GCC=$GCC
lt_save_CFLAGS=$CFLAGS
CC=${F77-"f77"}
CFLAGS=$FFLAGS
compiler=$CC
_LT_TAGVAR(compiler, $1)=$CC
_LT_CC_BASENAME([$compiler])
GCC=$G77
if test -n "$compiler"; then
AC_MSG_CHECKING([if libtool supports shared libraries])
AC_MSG_RESULT([$can_build_shared])
AC_MSG_CHECKING([whether to build shared libraries])
test "$can_build_shared" = "no" && enable_shared=no
# On AIX, shared libraries and static libraries use the same namespace, and
# are all built from PIC.
case $host_os in
aix3*)
test "$enable_shared" = yes && enable_static=no
if test -n "$RANLIB"; then
archive_cmds="$archive_cmds~\$RANLIB \$lib"
postinstall_cmds='$RANLIB $lib'
fi
;;
aix[[4-9]]*)
if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
test "$enable_shared" = yes && enable_static=no
fi
;;
esac
AC_MSG_RESULT([$enable_shared])
AC_MSG_CHECKING([whether to build static libraries])
# Make sure either enable_shared or enable_static is yes.
test "$enable_shared" = yes || enable_static=yes
AC_MSG_RESULT([$enable_static])
_LT_TAGVAR(GCC, $1)="$G77"
_LT_TAGVAR(LD, $1)="$LD"
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_SYS_DYNAMIC_LINKER($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
_LT_CONFIG($1)
fi # test -n "$compiler"
GCC=$lt_save_GCC
CC="$lt_save_CC"
CFLAGS="$lt_save_CFLAGS"
fi # test "$_lt_disable_F77" != yes
AC_LANG_POP
])# _LT_LANG_F77_CONFIG
# _LT_LANG_FC_CONFIG([TAG])
# -------------------------
# Ensure that the configuration variables for a Fortran compiler are
# suitably defined. These variables are subsequently used by _LT_CONFIG
# to write the compiler configuration to `libtool'.
m4_defun([_LT_LANG_FC_CONFIG],
[AC_LANG_PUSH(Fortran)
if test -z "$FC" || test "X$FC" = "Xno"; then
_lt_disable_FC=yes
fi
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(allow_undefined_flag, $1)=
_LT_TAGVAR(always_export_symbols, $1)=no
_LT_TAGVAR(archive_expsym_cmds, $1)=
_LT_TAGVAR(export_dynamic_flag_spec, $1)=
_LT_TAGVAR(hardcode_direct, $1)=no
_LT_TAGVAR(hardcode_direct_absolute, $1)=no
_LT_TAGVAR(hardcode_libdir_flag_spec, $1)=
_LT_TAGVAR(hardcode_libdir_separator, $1)=
_LT_TAGVAR(hardcode_minus_L, $1)=no
_LT_TAGVAR(hardcode_automatic, $1)=no
_LT_TAGVAR(inherit_rpath, $1)=no
_LT_TAGVAR(module_cmds, $1)=
_LT_TAGVAR(module_expsym_cmds, $1)=
_LT_TAGVAR(link_all_deplibs, $1)=unknown
_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
_LT_TAGVAR(reload_flag, $1)=$reload_flag
_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
_LT_TAGVAR(no_undefined_flag, $1)=
_LT_TAGVAR(whole_archive_flag_spec, $1)=
_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no
# Source file extension for fc test sources.
ac_ext=${ac_fc_srcext-f}
# Object file extension for compiled fc test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# No sense in running all these tests if we already determined that
# the FC compiler isn't working. Some variables (like enable_shared)
# are currently assumed to apply to all compilers on this platform,
# and will be corrupted by setting them based on a non-working compiler.
if test "$_lt_disable_FC" != yes; then
# Code to be used in simple compile tests
lt_simple_compile_test_code="\
subroutine t
return
end
"
# Code to be used in simple link tests
lt_simple_link_test_code="\
program t
end
"
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC="$CC"
lt_save_GCC=$GCC
lt_save_CFLAGS=$CFLAGS
CC=${FC-"f95"}
CFLAGS=$FCFLAGS
compiler=$CC
GCC=$ac_cv_fc_compiler_gnu
_LT_TAGVAR(compiler, $1)=$CC
_LT_CC_BASENAME([$compiler])
if test -n "$compiler"; then
AC_MSG_CHECKING([if libtool supports shared libraries])
AC_MSG_RESULT([$can_build_shared])
AC_MSG_CHECKING([whether to build shared libraries])
test "$can_build_shared" = "no" && enable_shared=no
# On AIX, shared libraries and static libraries use the same namespace, and
# are all built from PIC.
case $host_os in
aix3*)
test "$enable_shared" = yes && enable_static=no
if test -n "$RANLIB"; then
archive_cmds="$archive_cmds~\$RANLIB \$lib"
postinstall_cmds='$RANLIB $lib'
fi
;;
aix[[4-9]]*)
if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
test "$enable_shared" = yes && enable_static=no
fi
;;
esac
AC_MSG_RESULT([$enable_shared])
AC_MSG_CHECKING([whether to build static libraries])
# Make sure either enable_shared or enable_static is yes.
test "$enable_shared" = yes || enable_static=yes
AC_MSG_RESULT([$enable_static])
_LT_TAGVAR(GCC, $1)="$ac_cv_fc_compiler_gnu"
_LT_TAGVAR(LD, $1)="$LD"
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
_LT_SYS_HIDDEN_LIBDEPS($1)
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_SYS_DYNAMIC_LINKER($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
_LT_CONFIG($1)
fi # test -n "$compiler"
GCC=$lt_save_GCC
CC=$lt_save_CC
CFLAGS=$lt_save_CFLAGS
fi # test "$_lt_disable_FC" != yes
AC_LANG_POP
])# _LT_LANG_FC_CONFIG
# _LT_LANG_GCJ_CONFIG([TAG])
# --------------------------
# Ensure that the configuration variables for the GNU Java Compiler compiler
# are suitably defined. These variables are subsequently used by _LT_CONFIG
# to write the compiler configuration to `libtool'.
m4_defun([_LT_LANG_GCJ_CONFIG],
[AC_REQUIRE([LT_PROG_GCJ])dnl
AC_LANG_SAVE
# Source file extension for Java test sources.
ac_ext=java
# Object file extension for compiled Java test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# Code to be used in simple compile tests
lt_simple_compile_test_code="class foo {}"
# Code to be used in simple link tests
lt_simple_link_test_code='public class conftest { public static void main(String[[]] argv) {}; }'
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC=$CC
lt_save_CFLAGS=$CFLAGS
lt_save_GCC=$GCC
GCC=yes
CC=${GCJ-"gcj"}
CFLAGS=$GCJFLAGS
compiler=$CC
_LT_TAGVAR(compiler, $1)=$CC
_LT_TAGVAR(LD, $1)="$LD"
_LT_CC_BASENAME([$compiler])
# GCJ did not exist at the time GCC didn't implicitly link libc in.
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
_LT_TAGVAR(reload_flag, $1)=$reload_flag
_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
if test -n "$compiler"; then
_LT_COMPILER_NO_RTTI($1)
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
_LT_CONFIG($1)
fi
AC_LANG_RESTORE
GCC=$lt_save_GCC
CC=$lt_save_CC
CFLAGS=$lt_save_CFLAGS
])# _LT_LANG_GCJ_CONFIG
# _LT_LANG_GO_CONFIG([TAG])
# --------------------------
# Ensure that the configuration variables for the GNU Go compiler
# are suitably defined. These variables are subsequently used by _LT_CONFIG
# to write the compiler configuration to `libtool'.
m4_defun([_LT_LANG_GO_CONFIG],
[AC_REQUIRE([LT_PROG_GO])dnl
AC_LANG_SAVE
# Source file extension for Go test sources.
ac_ext=go
# Object file extension for compiled Go test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# Code to be used in simple compile tests
lt_simple_compile_test_code="package main; func main() { }"
# Code to be used in simple link tests
lt_simple_link_test_code='package main; func main() { }'
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC=$CC
lt_save_CFLAGS=$CFLAGS
lt_save_GCC=$GCC
GCC=yes
CC=${GOC-"gccgo"}
CFLAGS=$GOFLAGS
compiler=$CC
_LT_TAGVAR(compiler, $1)=$CC
_LT_TAGVAR(LD, $1)="$LD"
_LT_CC_BASENAME([$compiler])
# Go did not exist at the time GCC didn't implicitly link libc in.
_LT_TAGVAR(archive_cmds_need_lc, $1)=no
_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds
_LT_TAGVAR(reload_flag, $1)=$reload_flag
_LT_TAGVAR(reload_cmds, $1)=$reload_cmds
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
if test -n "$compiler"; then
_LT_COMPILER_NO_RTTI($1)
_LT_COMPILER_PIC($1)
_LT_COMPILER_C_O($1)
_LT_COMPILER_FILE_LOCKS($1)
_LT_LINKER_SHLIBS($1)
_LT_LINKER_HARDCODE_LIBPATH($1)
_LT_CONFIG($1)
fi
AC_LANG_RESTORE
GCC=$lt_save_GCC
CC=$lt_save_CC
CFLAGS=$lt_save_CFLAGS
])# _LT_LANG_GO_CONFIG
# _LT_LANG_RC_CONFIG([TAG])
# -------------------------
# Ensure that the configuration variables for the Windows resource compiler
# are suitably defined. These variables are subsequently used by _LT_CONFIG
# to write the compiler configuration to `libtool'.
m4_defun([_LT_LANG_RC_CONFIG],
[AC_REQUIRE([LT_PROG_RC])dnl
AC_LANG_SAVE
# Source file extension for RC test sources.
ac_ext=rc
# Object file extension for compiled RC test sources.
objext=o
_LT_TAGVAR(objext, $1)=$objext
# Code to be used in simple compile tests
lt_simple_compile_test_code='sample MENU { MENUITEM "&Soup", 100, CHECKED }'
# Code to be used in simple link tests
lt_simple_link_test_code="$lt_simple_compile_test_code"
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
_LT_TAG_COMPILER
# save warnings/boilerplate of simple test code
_LT_COMPILER_BOILERPLATE
_LT_LINKER_BOILERPLATE
# Allow CC to be a program name with arguments.
lt_save_CC="$CC"
lt_save_CFLAGS=$CFLAGS
lt_save_GCC=$GCC
GCC=
CC=${RC-"windres"}
CFLAGS=
compiler=$CC
_LT_TAGVAR(compiler, $1)=$CC
_LT_CC_BASENAME([$compiler])
_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes
if test -n "$compiler"; then
:
_LT_CONFIG($1)
fi
GCC=$lt_save_GCC
AC_LANG_RESTORE
CC=$lt_save_CC
CFLAGS=$lt_save_CFLAGS
])# _LT_LANG_RC_CONFIG
# LT_PROG_GCJ
# -----------
AC_DEFUN([LT_PROG_GCJ],
[m4_ifdef([AC_PROG_GCJ], [AC_PROG_GCJ],
[m4_ifdef([A][M_PROG_GCJ], [A][M_PROG_GCJ],
[AC_CHECK_TOOL(GCJ, gcj,)
test "x${GCJFLAGS+set}" = xset || GCJFLAGS="-g -O2"
AC_SUBST(GCJFLAGS)])])[]dnl
])
# Old name:
AU_ALIAS([LT_AC_PROG_GCJ], [LT_PROG_GCJ])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([LT_AC_PROG_GCJ], [])
# LT_PROG_GO
# ----------
AC_DEFUN([LT_PROG_GO],
[AC_CHECK_TOOL(GOC, gccgo,)
])
# LT_PROG_RC
# ----------
AC_DEFUN([LT_PROG_RC],
[AC_CHECK_TOOL(RC, windres,)
])
# Old name:
AU_ALIAS([LT_AC_PROG_RC], [LT_PROG_RC])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([LT_AC_PROG_RC], [])
# _LT_DECL_EGREP
# --------------
# If we don't have a new enough Autoconf to choose the best grep
# available, choose the one first in the user's PATH.
m4_defun([_LT_DECL_EGREP],
[AC_REQUIRE([AC_PROG_EGREP])dnl
AC_REQUIRE([AC_PROG_FGREP])dnl
test -z "$GREP" && GREP=grep
_LT_DECL([], [GREP], [1], [A grep program that handles long lines])
_LT_DECL([], [EGREP], [1], [An ERE matcher])
_LT_DECL([], [FGREP], [1], [A literal string matcher])
dnl Non-bleeding-edge autoconf doesn't subst GREP, so do it here too
AC_SUBST([GREP])
])
# _LT_DECL_OBJDUMP
# --------------
# If we don't have a new enough Autoconf to choose the best objdump
# available, choose the one first in the user's PATH.
m4_defun([_LT_DECL_OBJDUMP],
[AC_CHECK_TOOL(OBJDUMP, objdump, false)
test -z "$OBJDUMP" && OBJDUMP=objdump
_LT_DECL([], [OBJDUMP], [1], [An object symbol dumper])
AC_SUBST([OBJDUMP])
])
# _LT_DECL_DLLTOOL
# ----------------
# Ensure DLLTOOL variable is set.
m4_defun([_LT_DECL_DLLTOOL],
[AC_CHECK_TOOL(DLLTOOL, dlltool, false)
test -z "$DLLTOOL" && DLLTOOL=dlltool
_LT_DECL([], [DLLTOOL], [1], [DLL creation program])
AC_SUBST([DLLTOOL])
])
# _LT_DECL_SED
# ------------
# Check for a fully-functional sed program, that truncates
# as few characters as possible. Prefer GNU sed if found.
m4_defun([_LT_DECL_SED],
[AC_PROG_SED
test -z "$SED" && SED=sed
Xsed="$SED -e 1s/^X//"
_LT_DECL([], [SED], [1], [A sed program that does not truncate output])
_LT_DECL([], [Xsed], ["\$SED -e 1s/^X//"],
[Sed that helps us avoid accidentally triggering echo(1) options like -n])
])# _LT_DECL_SED
m4_ifndef([AC_PROG_SED], [
############################################################
# NOTE: This macro has been submitted for inclusion into #
# GNU Autoconf as AC_PROG_SED. When it is available in #
# a released version of Autoconf we should remove this #
# macro and use it instead. #
############################################################
m4_defun([AC_PROG_SED],
[AC_MSG_CHECKING([for a sed that does not truncate output])
AC_CACHE_VAL(lt_cv_path_SED,
[# Loop through the user's path and test for sed and gsed.
# Then use that list of sed's as ones to test for truncation.
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for lt_ac_prog in sed gsed; do
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$lt_ac_prog$ac_exec_ext"; then
lt_ac_sed_list="$lt_ac_sed_list $as_dir/$lt_ac_prog$ac_exec_ext"
fi
done
done
done
IFS=$as_save_IFS
lt_ac_max=0
lt_ac_count=0
# Add /usr/xpg4/bin/sed as it is typically found on Solaris
# along with /bin/sed that truncates output.
for lt_ac_sed in $lt_ac_sed_list /usr/xpg4/bin/sed; do
test ! -f $lt_ac_sed && continue
cat /dev/null > conftest.in
lt_ac_count=0
echo $ECHO_N "0123456789$ECHO_C" >conftest.in
# Check for GNU sed and select it if it is found.
if "$lt_ac_sed" --version 2>&1 < /dev/null | grep 'GNU' > /dev/null; then
lt_cv_path_SED=$lt_ac_sed
break
fi
while true; do
cat conftest.in conftest.in >conftest.tmp
mv conftest.tmp conftest.in
cp conftest.in conftest.nl
echo >>conftest.nl
$lt_ac_sed -e 's/a$//' < conftest.nl >conftest.out || break
cmp -s conftest.out conftest.nl || break
# 10000 chars as input seems more than enough
test $lt_ac_count -gt 10 && break
lt_ac_count=`expr $lt_ac_count + 1`
if test $lt_ac_count -gt $lt_ac_max; then
lt_ac_max=$lt_ac_count
lt_cv_path_SED=$lt_ac_sed
fi
done
done
])
SED=$lt_cv_path_SED
AC_SUBST([SED])
AC_MSG_RESULT([$SED])
])#AC_PROG_SED
])#m4_ifndef
# Old name:
AU_ALIAS([LT_AC_PROG_SED], [AC_PROG_SED])
dnl aclocal-1.4 backwards compatibility:
dnl AC_DEFUN([LT_AC_PROG_SED], [])
# _LT_CHECK_SHELL_FEATURES
# ------------------------
# Find out whether the shell is Bourne or XSI compatible,
# or has some other useful features.
m4_defun([_LT_CHECK_SHELL_FEATURES],
[AC_MSG_CHECKING([whether the shell understands some XSI constructs])
# Try some XSI features
xsi_shell=no
( _lt_dummy="a/b/c"
test "${_lt_dummy##*/},${_lt_dummy%/*},${_lt_dummy#??}"${_lt_dummy%"$_lt_dummy"}, \
= c,a/b,b/c, \
&& eval 'test $(( 1 + 1 )) -eq 2 \
&& test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \
&& xsi_shell=yes
AC_MSG_RESULT([$xsi_shell])
_LT_CONFIG_LIBTOOL_INIT([xsi_shell='$xsi_shell'])
AC_MSG_CHECKING([whether the shell understands "+="])
lt_shell_append=no
( foo=bar; set foo baz; eval "$[1]+=\$[2]" && test "$foo" = barbaz ) \
>/dev/null 2>&1 \
&& lt_shell_append=yes
AC_MSG_RESULT([$lt_shell_append])
_LT_CONFIG_LIBTOOL_INIT([lt_shell_append='$lt_shell_append'])
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
lt_unset=unset
else
lt_unset=false
fi
_LT_DECL([], [lt_unset], [0], [whether the shell understands "unset"])dnl
# test EBCDIC or ASCII
case `echo X|tr X '\101'` in
A) # ASCII based system
# \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
lt_SP2NL='tr \040 \012'
lt_NL2SP='tr \015\012 \040\040'
;;
*) # EBCDIC based system
lt_SP2NL='tr \100 \n'
lt_NL2SP='tr \r\n \100\100'
;;
esac
_LT_DECL([SP2NL], [lt_SP2NL], [1], [turn spaces into newlines])dnl
_LT_DECL([NL2SP], [lt_NL2SP], [1], [turn newlines into spaces])dnl
])# _LT_CHECK_SHELL_FEATURES
# _LT_PROG_FUNCTION_REPLACE (FUNCNAME, REPLACEMENT-BODY)
# ------------------------------------------------------
# In `$cfgfile', look for function FUNCNAME delimited by `^FUNCNAME ()$' and
# '^} FUNCNAME ', and replace its body with REPLACEMENT-BODY.
m4_defun([_LT_PROG_FUNCTION_REPLACE],
[dnl {
sed -e '/^$1 ()$/,/^} # $1 /c\
$1 ()\
{\
m4_bpatsubsts([$2], [$], [\\], [^\([ ]\)], [\\\1])
} # Extended-shell $1 implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
])
# _LT_PROG_REPLACE_SHELLFNS
# -------------------------
# Replace existing portable implementations of several shell functions with
# equivalent extended shell implementations where those features are available..
m4_defun([_LT_PROG_REPLACE_SHELLFNS],
[if test x"$xsi_shell" = xyes; then
_LT_PROG_FUNCTION_REPLACE([func_dirname], [dnl
case ${1} in
*/*) func_dirname_result="${1%/*}${2}" ;;
* ) func_dirname_result="${3}" ;;
esac])
_LT_PROG_FUNCTION_REPLACE([func_basename], [dnl
func_basename_result="${1##*/}"])
_LT_PROG_FUNCTION_REPLACE([func_dirname_and_basename], [dnl
case ${1} in
*/*) func_dirname_result="${1%/*}${2}" ;;
* ) func_dirname_result="${3}" ;;
esac
func_basename_result="${1##*/}"])
_LT_PROG_FUNCTION_REPLACE([func_stripname], [dnl
# pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are
# positional parameters, so assign one to ordinary parameter first.
func_stripname_result=${3}
func_stripname_result=${func_stripname_result#"${1}"}
func_stripname_result=${func_stripname_result%"${2}"}])
_LT_PROG_FUNCTION_REPLACE([func_split_long_opt], [dnl
func_split_long_opt_name=${1%%=*}
func_split_long_opt_arg=${1#*=}])
_LT_PROG_FUNCTION_REPLACE([func_split_short_opt], [dnl
func_split_short_opt_arg=${1#??}
func_split_short_opt_name=${1%"$func_split_short_opt_arg"}])
_LT_PROG_FUNCTION_REPLACE([func_lo2o], [dnl
case ${1} in
*.lo) func_lo2o_result=${1%.lo}.${objext} ;;
*) func_lo2o_result=${1} ;;
esac])
_LT_PROG_FUNCTION_REPLACE([func_xform], [ func_xform_result=${1%.*}.lo])
_LT_PROG_FUNCTION_REPLACE([func_arith], [ func_arith_result=$(( $[*] ))])
_LT_PROG_FUNCTION_REPLACE([func_len], [ func_len_result=${#1}])
fi
if test x"$lt_shell_append" = xyes; then
_LT_PROG_FUNCTION_REPLACE([func_append], [ eval "${1}+=\\${2}"])
_LT_PROG_FUNCTION_REPLACE([func_append_quoted], [dnl
func_quote_for_eval "${2}"
dnl m4 expansion turns \\\\ into \\, and then the shell eval turns that into \
eval "${1}+=\\\\ \\$func_quote_for_eval_result"])
# Save a `func_append' function call where possible by direct use of '+='
sed -e 's%func_append \([[a-zA-Z_]]\{1,\}\) "%\1+="%g' $cfgfile > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
else
# Save a `func_append' function call even when '+=' is not available
sed -e 's%func_append \([[a-zA-Z_]]\{1,\}\) "%\1="$\1%g' $cfgfile > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
fi
if test x"$_lt_function_replace_fail" = x":"; then
AC_MSG_WARN([Unable to substitute extended shell functions in $ofile])
fi
])
# _LT_PATH_CONVERSION_FUNCTIONS
# -----------------------------
# Determine which file name conversion functions should be used by
# func_to_host_file (and, implicitly, by func_to_host_path). These are needed
# for certain cross-compile configurations and native mingw.
m4_defun([_LT_PATH_CONVERSION_FUNCTIONS],
[AC_REQUIRE([AC_CANONICAL_HOST])dnl
AC_REQUIRE([AC_CANONICAL_BUILD])dnl
AC_MSG_CHECKING([how to convert $build file names to $host format])
AC_CACHE_VAL(lt_cv_to_host_file_cmd,
[case $host in
*-*-mingw* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32
;;
*-*-cygwin* )
lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32
;;
* ) # otherwise, assume *nix
lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32
;;
esac
;;
*-*-cygwin* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin
;;
*-*-cygwin* )
lt_cv_to_host_file_cmd=func_convert_file_noop
;;
* ) # otherwise, assume *nix
lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin
;;
esac
;;
* ) # unhandled hosts (and "normal" native builds)
lt_cv_to_host_file_cmd=func_convert_file_noop
;;
esac
])
to_host_file_cmd=$lt_cv_to_host_file_cmd
AC_MSG_RESULT([$lt_cv_to_host_file_cmd])
_LT_DECL([to_host_file_cmd], [lt_cv_to_host_file_cmd],
[0], [convert $build file names to $host format])dnl
AC_MSG_CHECKING([how to convert $build file names to toolchain format])
AC_CACHE_VAL(lt_cv_to_tool_file_cmd,
[#assume ordinary cross tools, or native build.
lt_cv_to_tool_file_cmd=func_convert_file_noop
case $host in
*-*-mingw* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32
;;
esac
;;
esac
])
to_tool_file_cmd=$lt_cv_to_tool_file_cmd
AC_MSG_RESULT([$lt_cv_to_tool_file_cmd])
_LT_DECL([to_tool_file_cmd], [lt_cv_to_tool_file_cmd],
[0], [convert $build files to toolchain format])dnl
])# _LT_PATH_CONVERSION_FUNCTIONS
arpack-ng-3.1.5/m4/ax_blas.m4 0000644 0001750 0001750 00000015136 12277373057 012522 0000000 0000000 # ===========================================================================
# http://www.gnu.org/software/autoconf-archive/ax_blas.html
# ===========================================================================
#
# SYNOPSIS
#
# AX_BLAS([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
#
# DESCRIPTION
#
# This macro looks for a library that implements the BLAS linear-algebra
# interface (see http://www.netlib.org/blas/). On success, it sets the
# BLAS_LIBS output variable to hold the requisite library linkages.
#
# To link with BLAS, you should link with:
#
# $BLAS_LIBS $LIBS $FLIBS
#
# in that order. FLIBS is the output variable of the
# AC_F77_LIBRARY_LDFLAGS macro (called if necessary by AX_BLAS), and is
# sometimes necessary in order to link with F77 libraries. Users will also
# need to use AC_F77_DUMMY_MAIN (see the autoconf manual), for the same
# reason.
#
# Many libraries are searched for, from ATLAS to CXML to ESSL. The user
# may also use --with-blas= in order to use some specific BLAS
# library . In order to link successfully, however, be aware that you
# will probably need to use the same Fortran compiler (which can be set
# via the F77 env. var.) as was used to compile the BLAS library.
#
# ACTION-IF-FOUND is a list of shell commands to run if a BLAS library is
# found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it is
# not found. If ACTION-IF-FOUND is not specified, the default action will
# define HAVE_BLAS.
#
# LICENSE
#
# Copyright (c) 2008 Steven G. Johnson
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program. If not, see .
#
# As a special exception, the respective Autoconf Macro's copyright owner
# gives unlimited permission to copy, distribute and modify the configure
# scripts that are the output of Autoconf when processing the Macro. You
# need not follow the terms of the GNU General Public License when using
# or distributing such scripts, even though portions of the text of the
# Macro appear in them. The GNU General Public License (GPL) does govern
# all other use of the material that constitutes the Autoconf Macro.
#
# This special exception to the GPL applies to versions of the Autoconf
# Macro released by the Autoconf Archive. When you make and distribute a
# modified version of the Autoconf Macro, you may extend this special
# exception to the GPL to apply to your modified version as well.
#serial 11
AU_ALIAS([ACX_BLAS], [AX_BLAS])
AC_DEFUN([AX_BLAS], [
AC_PREREQ(2.50)
AC_REQUIRE([AC_F77_LIBRARY_LDFLAGS])
ax_blas_ok=no
AC_ARG_WITH(blas,
[AS_HELP_STRING([--with-blas=], [use BLAS library ])])
case $with_blas in
yes | "") ;;
no) ax_blas_ok=disable ;;
-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;
*) BLAS_LIBS="-l$with_blas" ;;
esac
# Get fortran linker names of BLAS functions to check for.
AC_F77_FUNC(sgemm)
AC_F77_FUNC(dgemm)
ax_blas_save_LIBS="$LIBS"
LIBS="$LIBS $FLIBS"
# First, check BLAS_LIBS environment variable
if test $ax_blas_ok = no; then
if test "x$BLAS_LIBS" != x; then
save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
AC_MSG_CHECKING([for $sgemm in $BLAS_LIBS])
AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes], [BLAS_LIBS=""])
AC_MSG_RESULT($ax_blas_ok)
LIBS="$save_LIBS"
fi
fi
# BLAS linked to by default? (happens on some supercomputers)
if test $ax_blas_ok = no; then
save_LIBS="$LIBS"; LIBS="$LIBS"
AC_MSG_CHECKING([if $sgemm is being linked in already])
AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes])
AC_MSG_RESULT($ax_blas_ok)
LIBS="$save_LIBS"
fi
# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)
if test $ax_blas_ok = no; then
AC_CHECK_LIB(atlas, ATL_xerbla,
[AC_CHECK_LIB(f77blas, $sgemm,
[AC_CHECK_LIB(cblas, cblas_dgemm,
[ax_blas_ok=yes
BLAS_LIBS="-lcblas -lf77blas -latlas"],
[], [-lf77blas -latlas])],
[], [-latlas])])
fi
# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)
if test $ax_blas_ok = no; then
AC_CHECK_LIB(blas, $sgemm,
[AC_CHECK_LIB(dgemm, $dgemm,
[AC_CHECK_LIB(sgemm, $sgemm,
[ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"],
[], [-lblas])],
[], [-lblas])])
fi
# BLAS in Intel MKL library?
if test $ax_blas_ok = no; then
AC_CHECK_LIB(mkl, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lmkl"])
fi
# BLAS in Apple vecLib library?
if test $ax_blas_ok = no; then
save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"
AC_MSG_CHECKING([for $sgemm in -framework vecLib])
AC_TRY_LINK_FUNC($sgemm, [ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"])
AC_MSG_RESULT($ax_blas_ok)
LIBS="$save_LIBS"
fi
# BLAS in Alpha CXML library?
if test $ax_blas_ok = no; then
AC_CHECK_LIB(cxml, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-lcxml"])
fi
# BLAS in Alpha DXML library? (now called CXML, see above)
if test $ax_blas_ok = no; then
AC_CHECK_LIB(dxml, $sgemm, [ax_blas_ok=yes;BLAS_LIBS="-ldxml"])
fi
# BLAS in Sun Performance library?
if test $ax_blas_ok = no; then
if test "x$GCC" != xyes; then # only works with Sun CC
AC_CHECK_LIB(sunmath, acosp,
[AC_CHECK_LIB(sunperf, $sgemm,
[BLAS_LIBS="-xlic_lib=sunperf -lsunmath"
ax_blas_ok=yes],[],[-lsunmath])])
fi
fi
# BLAS in SCSL library? (SGI/Cray Scientific Library)
if test $ax_blas_ok = no; then
AC_CHECK_LIB(scs, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lscs"])
fi
# BLAS in SGIMATH library?
if test $ax_blas_ok = no; then
AC_CHECK_LIB(complib.sgimath, $sgemm,
[ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"])
fi
# BLAS in IBM ESSL library? (requires generic BLAS lib, too)
if test $ax_blas_ok = no; then
AC_CHECK_LIB(blas, $sgemm,
[AC_CHECK_LIB(essl, $sgemm,
[ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"],
[], [-lblas $FLIBS])])
fi
# Generic BLAS library?
if test $ax_blas_ok = no; then
AC_CHECK_LIB(blas, $sgemm, [ax_blas_ok=yes; BLAS_LIBS="-lblas"])
fi
AC_SUBST(BLAS_LIBS)
LIBS="$ax_blas_save_LIBS"
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$ax_blas_ok" = xyes; then
ifelse([$1],,AC_DEFINE(HAVE_BLAS,1,[Define if you have a BLAS library.]),[$1])
:
else
ax_blas_ok=no
$2
fi
])dnl AX_BLAS
arpack-ng-3.1.5/m4/ax_lapack.m4 0000644 0001750 0001750 00000011660 12277373057 013032 0000000 0000000 # ===========================================================================
# http://www.gnu.org/software/autoconf-archive/ax_lapack.html
# ===========================================================================
#
# SYNOPSIS
#
# AX_LAPACK([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
#
# DESCRIPTION
#
# This macro looks for a library that implements the LAPACK linear-algebra
# interface (see http://www.netlib.org/lapack/). On success, it sets the
# LAPACK_LIBS output variable to hold the requisite library linkages.
#
# To link with LAPACK, you should link with:
#
# $LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS
#
# in that order. BLAS_LIBS is the output variable of the AX_BLAS macro,
# called automatically. FLIBS is the output variable of the
# AC_F77_LIBRARY_LDFLAGS macro (called if necessary by AX_BLAS), and is
# sometimes necessary in order to link with F77 libraries. Users will also
# need to use AC_F77_DUMMY_MAIN (see the autoconf manual), for the same
# reason.
#
# The user may also use --with-lapack= in order to use some specific
# LAPACK library . In order to link successfully, however, be aware
# that you will probably need to use the same Fortran compiler (which can
# be set via the F77 env. var.) as was used to compile the LAPACK and BLAS
# libraries.
#
# ACTION-IF-FOUND is a list of shell commands to run if a LAPACK library
# is found, and ACTION-IF-NOT-FOUND is a list of commands to run it if it
# is not found. If ACTION-IF-FOUND is not specified, the default action
# will define HAVE_LAPACK.
#
# LICENSE
#
# Copyright (c) 2009 Steven G. Johnson
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program. If not, see .
#
# As a special exception, the respective Autoconf Macro's copyright owner
# gives unlimited permission to copy, distribute and modify the configure
# scripts that are the output of Autoconf when processing the Macro. You
# need not follow the terms of the GNU General Public License when using
# or distributing such scripts, even though portions of the text of the
# Macro appear in them. The GNU General Public License (GPL) does govern
# all other use of the material that constitutes the Autoconf Macro.
#
# This special exception to the GPL applies to versions of the Autoconf
# Macro released by the Autoconf Archive. When you make and distribute a
# modified version of the Autoconf Macro, you may extend this special
# exception to the GPL to apply to your modified version as well.
#serial 7
AU_ALIAS([ACX_LAPACK], [AX_LAPACK])
AC_DEFUN([AX_LAPACK], [
AC_REQUIRE([AX_BLAS])
ax_lapack_ok=no
AC_ARG_WITH(lapack,
[AS_HELP_STRING([--with-lapack=], [use LAPACK library ])])
case $with_lapack in
yes | "") ;;
no) ax_lapack_ok=disable ;;
-* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$with_lapack" ;;
*) LAPACK_LIBS="-l$with_lapack" ;;
esac
# Get fortran linker name of LAPACK function to check for.
AC_F77_FUNC(cheev)
# We cannot use LAPACK if BLAS is not found
if test "x$ax_blas_ok" != xyes; then
ax_lapack_ok=noblas
LAPACK_LIBS=""
fi
# First, check LAPACK_LIBS environment variable
if test "x$LAPACK_LIBS" != x; then
save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS"
AC_MSG_CHECKING([for $cheev in $LAPACK_LIBS])
AC_TRY_LINK_FUNC($cheev, [ax_lapack_ok=yes], [LAPACK_LIBS=""])
AC_MSG_RESULT($ax_lapack_ok)
LIBS="$save_LIBS"
if test $ax_lapack_ok = no; then
LAPACK_LIBS=""
fi
fi
# LAPACK linked to by default? (is sometimes included in BLAS lib)
if test $ax_lapack_ok = no; then
save_LIBS="$LIBS"; LIBS="$LIBS $BLAS_LIBS $FLIBS"
AC_CHECK_FUNC($cheev, [ax_lapack_ok=yes])
LIBS="$save_LIBS"
fi
# Generic LAPACK library?
for lapack in lapack lapack_rs6k; do
if test $ax_lapack_ok = no; then
save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
AC_CHECK_LIB($lapack, $cheev,
[ax_lapack_ok=yes; LAPACK_LIBS="-l$lapack"], [], [$FLIBS])
LIBS="$save_LIBS"
fi
done
AC_SUBST(LAPACK_LIBS)
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$ax_lapack_ok" = xyes; then
ifelse([$1],,AC_DEFINE(HAVE_LAPACK,1,[Define if you have LAPACK library.]),[$1])
:
else
ax_lapack_ok=no
$2
fi
])dnl AX_LAPACK
arpack-ng-3.1.5/m4/lt~obsolete.m4 0000644 0001750 0001750 00000013756 12277373057 013471 0000000 0000000 # lt~obsolete.m4 -- aclocal satisfying obsolete definitions. -*-Autoconf-*-
#
# Copyright (C) 2004, 2005, 2007, 2009 Free Software Foundation, Inc.
# Written by Scott James Remnant, 2004.
#
# This file is free software; the Free Software Foundation gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
# serial 5 lt~obsolete.m4
# These exist entirely to fool aclocal when bootstrapping libtool.
#
# In the past libtool.m4 has provided macros via AC_DEFUN (or AU_DEFUN)
# which have later been changed to m4_define as they aren't part of the
# exported API, or moved to Autoconf or Automake where they belong.
#
# The trouble is, aclocal is a bit thick. It'll see the old AC_DEFUN
# in /usr/share/aclocal/libtool.m4 and remember it, then when it sees us
# using a macro with the same name in our local m4/libtool.m4 it'll
# pull the old libtool.m4 in (it doesn't see our shiny new m4_define
# and doesn't know about Autoconf macros at all.)
#
# So we provide this file, which has a silly filename so it's always
# included after everything else. This provides aclocal with the
# AC_DEFUNs it wants, but when m4 processes it, it doesn't do anything
# because those macros already exist, or will be overwritten later.
# We use AC_DEFUN over AU_DEFUN for compatibility with aclocal-1.6.
#
# Anytime we withdraw an AC_DEFUN or AU_DEFUN, remember to add it here.
# Yes, that means every name once taken will need to remain here until
# we give up compatibility with versions before 1.7, at which point
# we need to keep only those names which we still refer to.
# This is to help aclocal find these macros, as it can't see m4_define.
AC_DEFUN([LTOBSOLETE_VERSION], [m4_if([1])])
m4_ifndef([AC_LIBTOOL_LINKER_OPTION], [AC_DEFUN([AC_LIBTOOL_LINKER_OPTION])])
m4_ifndef([AC_PROG_EGREP], [AC_DEFUN([AC_PROG_EGREP])])
m4_ifndef([_LT_AC_PROG_ECHO_BACKSLASH], [AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH])])
m4_ifndef([_LT_AC_SHELL_INIT], [AC_DEFUN([_LT_AC_SHELL_INIT])])
m4_ifndef([_LT_AC_SYS_LIBPATH_AIX], [AC_DEFUN([_LT_AC_SYS_LIBPATH_AIX])])
m4_ifndef([_LT_PROG_LTMAIN], [AC_DEFUN([_LT_PROG_LTMAIN])])
m4_ifndef([_LT_AC_TAGVAR], [AC_DEFUN([_LT_AC_TAGVAR])])
m4_ifndef([AC_LTDL_ENABLE_INSTALL], [AC_DEFUN([AC_LTDL_ENABLE_INSTALL])])
m4_ifndef([AC_LTDL_PREOPEN], [AC_DEFUN([AC_LTDL_PREOPEN])])
m4_ifndef([_LT_AC_SYS_COMPILER], [AC_DEFUN([_LT_AC_SYS_COMPILER])])
m4_ifndef([_LT_AC_LOCK], [AC_DEFUN([_LT_AC_LOCK])])
m4_ifndef([AC_LIBTOOL_SYS_OLD_ARCHIVE], [AC_DEFUN([AC_LIBTOOL_SYS_OLD_ARCHIVE])])
m4_ifndef([_LT_AC_TRY_DLOPEN_SELF], [AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF])])
m4_ifndef([AC_LIBTOOL_PROG_CC_C_O], [AC_DEFUN([AC_LIBTOOL_PROG_CC_C_O])])
m4_ifndef([AC_LIBTOOL_SYS_HARD_LINK_LOCKS], [AC_DEFUN([AC_LIBTOOL_SYS_HARD_LINK_LOCKS])])
m4_ifndef([AC_LIBTOOL_OBJDIR], [AC_DEFUN([AC_LIBTOOL_OBJDIR])])
m4_ifndef([AC_LTDL_OBJDIR], [AC_DEFUN([AC_LTDL_OBJDIR])])
m4_ifndef([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH], [AC_DEFUN([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH])])
m4_ifndef([AC_LIBTOOL_SYS_LIB_STRIP], [AC_DEFUN([AC_LIBTOOL_SYS_LIB_STRIP])])
m4_ifndef([AC_PATH_MAGIC], [AC_DEFUN([AC_PATH_MAGIC])])
m4_ifndef([AC_PROG_LD_GNU], [AC_DEFUN([AC_PROG_LD_GNU])])
m4_ifndef([AC_PROG_LD_RELOAD_FLAG], [AC_DEFUN([AC_PROG_LD_RELOAD_FLAG])])
m4_ifndef([AC_DEPLIBS_CHECK_METHOD], [AC_DEFUN([AC_DEPLIBS_CHECK_METHOD])])
m4_ifndef([AC_LIBTOOL_PROG_COMPILER_NO_RTTI], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_NO_RTTI])])
m4_ifndef([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE], [AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])])
m4_ifndef([AC_LIBTOOL_PROG_COMPILER_PIC], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_PIC])])
m4_ifndef([AC_LIBTOOL_PROG_LD_SHLIBS], [AC_DEFUN([AC_LIBTOOL_PROG_LD_SHLIBS])])
m4_ifndef([AC_LIBTOOL_POSTDEP_PREDEP], [AC_DEFUN([AC_LIBTOOL_POSTDEP_PREDEP])])
m4_ifndef([LT_AC_PROG_EGREP], [AC_DEFUN([LT_AC_PROG_EGREP])])
m4_ifndef([LT_AC_PROG_SED], [AC_DEFUN([LT_AC_PROG_SED])])
m4_ifndef([_LT_CC_BASENAME], [AC_DEFUN([_LT_CC_BASENAME])])
m4_ifndef([_LT_COMPILER_BOILERPLATE], [AC_DEFUN([_LT_COMPILER_BOILERPLATE])])
m4_ifndef([_LT_LINKER_BOILERPLATE], [AC_DEFUN([_LT_LINKER_BOILERPLATE])])
m4_ifndef([_AC_PROG_LIBTOOL], [AC_DEFUN([_AC_PROG_LIBTOOL])])
m4_ifndef([AC_LIBTOOL_SETUP], [AC_DEFUN([AC_LIBTOOL_SETUP])])
m4_ifndef([_LT_AC_CHECK_DLFCN], [AC_DEFUN([_LT_AC_CHECK_DLFCN])])
m4_ifndef([AC_LIBTOOL_SYS_DYNAMIC_LINKER], [AC_DEFUN([AC_LIBTOOL_SYS_DYNAMIC_LINKER])])
m4_ifndef([_LT_AC_TAGCONFIG], [AC_DEFUN([_LT_AC_TAGCONFIG])])
m4_ifndef([AC_DISABLE_FAST_INSTALL], [AC_DEFUN([AC_DISABLE_FAST_INSTALL])])
m4_ifndef([_LT_AC_LANG_CXX], [AC_DEFUN([_LT_AC_LANG_CXX])])
m4_ifndef([_LT_AC_LANG_F77], [AC_DEFUN([_LT_AC_LANG_F77])])
m4_ifndef([_LT_AC_LANG_GCJ], [AC_DEFUN([_LT_AC_LANG_GCJ])])
m4_ifndef([AC_LIBTOOL_LANG_C_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_C_CONFIG])])
m4_ifndef([_LT_AC_LANG_C_CONFIG], [AC_DEFUN([_LT_AC_LANG_C_CONFIG])])
m4_ifndef([AC_LIBTOOL_LANG_CXX_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_CXX_CONFIG])])
m4_ifndef([_LT_AC_LANG_CXX_CONFIG], [AC_DEFUN([_LT_AC_LANG_CXX_CONFIG])])
m4_ifndef([AC_LIBTOOL_LANG_F77_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_F77_CONFIG])])
m4_ifndef([_LT_AC_LANG_F77_CONFIG], [AC_DEFUN([_LT_AC_LANG_F77_CONFIG])])
m4_ifndef([AC_LIBTOOL_LANG_GCJ_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_GCJ_CONFIG])])
m4_ifndef([_LT_AC_LANG_GCJ_CONFIG], [AC_DEFUN([_LT_AC_LANG_GCJ_CONFIG])])
m4_ifndef([AC_LIBTOOL_LANG_RC_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_RC_CONFIG])])
m4_ifndef([_LT_AC_LANG_RC_CONFIG], [AC_DEFUN([_LT_AC_LANG_RC_CONFIG])])
m4_ifndef([AC_LIBTOOL_CONFIG], [AC_DEFUN([AC_LIBTOOL_CONFIG])])
m4_ifndef([_LT_AC_FILE_LTDLL_C], [AC_DEFUN([_LT_AC_FILE_LTDLL_C])])
m4_ifndef([_LT_REQUIRED_DARWIN_CHECKS], [AC_DEFUN([_LT_REQUIRED_DARWIN_CHECKS])])
m4_ifndef([_LT_AC_PROG_CXXCPP], [AC_DEFUN([_LT_AC_PROG_CXXCPP])])
m4_ifndef([_LT_PREPARE_SED_QUOTE_VARS], [AC_DEFUN([_LT_PREPARE_SED_QUOTE_VARS])])
m4_ifndef([_LT_PROG_ECHO_BACKSLASH], [AC_DEFUN([_LT_PROG_ECHO_BACKSLASH])])
m4_ifndef([_LT_PROG_F77], [AC_DEFUN([_LT_PROG_F77])])
m4_ifndef([_LT_PROG_FC], [AC_DEFUN([_LT_PROG_FC])])
m4_ifndef([_LT_PROG_CXX], [AC_DEFUN([_LT_PROG_CXX])])
arpack-ng-3.1.5/m4/ltsugar.m4 0000644 0001750 0001750 00000010424 12277373057 012565 0000000 0000000 # ltsugar.m4 -- libtool m4 base layer. -*-Autoconf-*-
#
# Copyright (C) 2004, 2005, 2007, 2008 Free Software Foundation, Inc.
# Written by Gary V. Vaughan, 2004
#
# This file is free software; the Free Software Foundation gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
# serial 6 ltsugar.m4
# This is to help aclocal find these macros, as it can't see m4_define.
AC_DEFUN([LTSUGAR_VERSION], [m4_if([0.1])])
# lt_join(SEP, ARG1, [ARG2...])
# -----------------------------
# Produce ARG1SEPARG2...SEPARGn, omitting [] arguments and their
# associated separator.
# Needed until we can rely on m4_join from Autoconf 2.62, since all earlier
# versions in m4sugar had bugs.
m4_define([lt_join],
[m4_if([$#], [1], [],
[$#], [2], [[$2]],
[m4_if([$2], [], [], [[$2]_])$0([$1], m4_shift(m4_shift($@)))])])
m4_define([_lt_join],
[m4_if([$#$2], [2], [],
[m4_if([$2], [], [], [[$1$2]])$0([$1], m4_shift(m4_shift($@)))])])
# lt_car(LIST)
# lt_cdr(LIST)
# ------------
# Manipulate m4 lists.
# These macros are necessary as long as will still need to support
# Autoconf-2.59 which quotes differently.
m4_define([lt_car], [[$1]])
m4_define([lt_cdr],
[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])],
[$#], 1, [],
[m4_dquote(m4_shift($@))])])
m4_define([lt_unquote], $1)
# lt_append(MACRO-NAME, STRING, [SEPARATOR])
# ------------------------------------------
# Redefine MACRO-NAME to hold its former content plus `SEPARATOR'`STRING'.
# Note that neither SEPARATOR nor STRING are expanded; they are appended
# to MACRO-NAME as is (leaving the expansion for when MACRO-NAME is invoked).
# No SEPARATOR is output if MACRO-NAME was previously undefined (different
# than defined and empty).
#
# This macro is needed until we can rely on Autoconf 2.62, since earlier
# versions of m4sugar mistakenly expanded SEPARATOR but not STRING.
m4_define([lt_append],
[m4_define([$1],
m4_ifdef([$1], [m4_defn([$1])[$3]])[$2])])
# lt_combine(SEP, PREFIX-LIST, INFIX, SUFFIX1, [SUFFIX2...])
# ----------------------------------------------------------
# Produce a SEP delimited list of all paired combinations of elements of
# PREFIX-LIST with SUFFIX1 through SUFFIXn. Each element of the list
# has the form PREFIXmINFIXSUFFIXn.
# Needed until we can rely on m4_combine added in Autoconf 2.62.
m4_define([lt_combine],
[m4_if(m4_eval([$# > 3]), [1],
[m4_pushdef([_Lt_sep], [m4_define([_Lt_sep], m4_defn([lt_car]))])]]dnl
[[m4_foreach([_Lt_prefix], [$2],
[m4_foreach([_Lt_suffix],
]m4_dquote(m4_dquote(m4_shift(m4_shift(m4_shift($@)))))[,
[_Lt_sep([$1])[]m4_defn([_Lt_prefix])[$3]m4_defn([_Lt_suffix])])])])])
# lt_if_append_uniq(MACRO-NAME, VARNAME, [SEPARATOR], [UNIQ], [NOT-UNIQ])
# -----------------------------------------------------------------------
# Iff MACRO-NAME does not yet contain VARNAME, then append it (delimited
# by SEPARATOR if supplied) and expand UNIQ, else NOT-UNIQ.
m4_define([lt_if_append_uniq],
[m4_ifdef([$1],
[m4_if(m4_index([$3]m4_defn([$1])[$3], [$3$2$3]), [-1],
[lt_append([$1], [$2], [$3])$4],
[$5])],
[lt_append([$1], [$2], [$3])$4])])
# lt_dict_add(DICT, KEY, VALUE)
# -----------------------------
m4_define([lt_dict_add],
[m4_define([$1($2)], [$3])])
# lt_dict_add_subkey(DICT, KEY, SUBKEY, VALUE)
# --------------------------------------------
m4_define([lt_dict_add_subkey],
[m4_define([$1($2:$3)], [$4])])
# lt_dict_fetch(DICT, KEY, [SUBKEY])
# ----------------------------------
m4_define([lt_dict_fetch],
[m4_ifval([$3],
m4_ifdef([$1($2:$3)], [m4_defn([$1($2:$3)])]),
m4_ifdef([$1($2)], [m4_defn([$1($2)])]))])
# lt_if_dict_fetch(DICT, KEY, [SUBKEY], VALUE, IF-TRUE, [IF-FALSE])
# -----------------------------------------------------------------
m4_define([lt_if_dict_fetch],
[m4_if(lt_dict_fetch([$1], [$2], [$3]), [$4],
[$5],
[$6])])
# lt_dict_filter(DICT, [SUBKEY], VALUE, [SEPARATOR], KEY, [...])
# --------------------------------------------------------------
m4_define([lt_dict_filter],
[m4_if([$5], [], [],
[lt_join(m4_quote(m4_default([$4], [[, ]])),
lt_unquote(m4_split(m4_normalize(m4_foreach(_Lt_key, lt_car([m4_shiftn(4, $@)]),
[lt_if_dict_fetch([$1], _Lt_key, [$2], [$3], [_Lt_key ])])))))])[]dnl
])
arpack-ng-3.1.5/m4/ltversion.m4 0000644 0001750 0001750 00000001262 12277373057 013131 0000000 0000000 # ltversion.m4 -- version numbers -*- Autoconf -*-
#
# Copyright (C) 2004 Free Software Foundation, Inc.
# Written by Scott James Remnant, 2004
#
# This file is free software; the Free Software Foundation gives
# unlimited permission to copy and/or distribute it, with or without
# modifications, as long as this notice is preserved.
# @configure_input@
# serial 3337 ltversion.m4
# This file is part of GNU Libtool
m4_define([LT_PACKAGE_VERSION], [2.4.2])
m4_define([LT_PACKAGE_REVISION], [1.3337])
AC_DEFUN([LTVERSION_VERSION],
[macro_version='2.4.2'
macro_revision='1.3337'
_LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?])
_LT_DECL(, macro_revision, 0)
])
arpack-ng-3.1.5/m4/ax_mpi.m4 0000644 0001750 0001750 00000015361 12277373057 012366 0000000 0000000 # ===========================================================================
# http://www.gnu.org/software/autoconf-archive/ax_mpi.html
# ===========================================================================
#
# SYNOPSIS
#
# AX_MPI([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
#
# DESCRIPTION
#
# This macro tries to find out how to compile programs that use MPI
# (Message Passing Interface), a standard API for parallel process
# communication (see http://www-unix.mcs.anl.gov/mpi/)
#
# On success, it sets the MPICC, MPICXX, MPIF77, or MPIFC output variable
# to the name of the MPI compiler, depending upon the current language.
# (This may just be $CC/$CXX/$F77/$FC, but is more often something like
# mpicc/mpiCC/mpif77/mpif90.) It also sets MPILIBS to any libraries that
# are needed for linking MPI (e.g. -lmpi or -lfmpi, if a special
# MPICC/MPICXX/MPIF77/MPIFC was not found).
#
# If you want to compile everything with MPI, you should use something
# like this for C:
#
# if test -z "$CC" && test -n "$MPICC"; then
# CC="$MPICC"
# fi
# AC_PROG_CC
# AX_MPI
# CC="$MPICC"
# LIBS="$MPILIBS $LIBS"
#
# and similar for C++ (change all instances of CC to CXX), Fortran 77
# (with F77 instead of CC) or Fortran (with FC instead of CC).
#
# NOTE: The above assumes that you will use $CC (or whatever) for linking
# as well as for compiling. (This is the default for automake and most
# Makefiles.)
#
# The user can force a particular library/compiler by setting the
# MPICC/MPICXX/MPIF77/MPIFC and/or MPILIBS environment variables.
#
# ACTION-IF-FOUND is a list of shell commands to run if an MPI library is
# found, and ACTION-IF-NOT-FOUND is a list of commands to run if it is not
# found. If ACTION-IF-FOUND is not specified, the default action will
# define HAVE_MPI.
#
# LICENSE
#
# Copyright (c) 2008 Steven G. Johnson
# Copyright (c) 2008 Julian C. Cummings
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program. If not, see .
#
# As a special exception, the respective Autoconf Macro's copyright owner
# gives unlimited permission to copy, distribute and modify the configure
# scripts that are the output of Autoconf when processing the Macro. You
# need not follow the terms of the GNU General Public License when using
# or distributing such scripts, even though portions of the text of the
# Macro appear in them. The GNU General Public License (GPL) does govern
# all other use of the material that constitutes the Autoconf Macro.
#
# This special exception to the GPL applies to versions of the Autoconf
# Macro released by the Autoconf Archive. When you make and distribute a
# modified version of the Autoconf Macro, you may extend this special
# exception to the GPL to apply to your modified version as well.
#serial 7
AU_ALIAS([ACX_MPI], [AX_MPI])
AC_DEFUN([AX_MPI], [
AC_PREREQ(2.50) dnl for AC_LANG_CASE
AC_LANG_CASE([C], [
AC_REQUIRE([AC_PROG_CC])
AC_ARG_VAR(MPICC,[MPI C compiler command])
AC_CHECK_PROGS(MPICC, mpicc hcc mpxlc_r mpxlc mpcc cmpicc, $CC)
ax_mpi_save_CC="$CC"
CC="$MPICC"
AC_SUBST(MPICC)
],
[C++], [
AC_REQUIRE([AC_PROG_CXX])
AC_ARG_VAR(MPICXX,[MPI C++ compiler command])
AC_CHECK_PROGS(MPICXX, mpic++ mpicxx mpiCC hcp mpxlC_r mpxlC mpCC cmpic++, $CXX)
ax_mpi_save_CXX="$CXX"
CXX="$MPICXX"
AC_SUBST(MPICXX)
],
[Fortran 77], [
AC_REQUIRE([AC_PROG_F77])
AC_ARG_VAR(MPIF77,[MPI Fortran 77 compiler command])
AC_CHECK_PROGS(MPIF77, mpif77 hf77 mpxlf_r mpxlf mpf77 cmpifc, $F77)
ax_mpi_save_F77="$F77"
F77="$MPIF77"
AC_SUBST(MPIF77)
],
[Fortran], [
AC_REQUIRE([AC_PROG_FC])
AC_ARG_VAR(MPIFC,[MPI Fortran compiler command])
AC_CHECK_PROGS(MPIFC, mpif90 mpxlf95_r mpxlf90_r mpxlf95 mpxlf90 mpf90 cmpif90c, $FC)
ax_mpi_save_FC="$FC"
FC="$MPIFC"
AC_SUBST(MPIFC)
])
if test x = x"$MPILIBS"; then
AC_LANG_CASE([C], [AC_CHECK_FUNC(MPI_Init, [MPILIBS=" "])],
[C++], [AC_CHECK_FUNC(MPI_Init, [MPILIBS=" "])],
[Fortran 77], [AC_MSG_CHECKING([for MPI_Init])
AC_LINK_IFELSE([AC_LANG_PROGRAM([],[ call MPI_Init])],[MPILIBS=""
AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no)])],
[Fortran], [AC_MSG_CHECKING([for MPI_Init])
AC_LINK_IFELSE([AC_LANG_PROGRAM([],[ call MPI_Init])],[MPILIBS=" "
AC_MSG_RESULT(yes)], [AC_MSG_RESULT(no)])])
fi
AC_LANG_CASE([Fortran 77], [
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(fmpi, MPI_Init, [MPILIBS="-lfmpi"])
fi
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(fmpich, MPI_Init, [MPILIBS="-lfmpich"])
fi
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(mpif77, MPI_Init, [MPILIBS="-lmpif77"])
fi
],
[Fortran], [
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(fmpi, MPI_Init, [MPILIBS="-lfmpi"])
fi
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(mpichf90, MPI_Init, [MPILIBS="-lmpichf90"])
fi
])
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(mpi, MPI_Init, [MPILIBS="-lmpi"])
fi
if test x = x"$MPILIBS"; then
AC_CHECK_LIB(mpich, MPI_Init, [MPILIBS="-lmpich"])
fi
dnl We have to use AC_TRY_COMPILE and not AC_CHECK_HEADER because the
dnl latter uses $CPP, not $CC (which may be mpicc).
AC_LANG_CASE([C], [if test x != x"$MPILIBS"; then
AC_MSG_CHECKING([for mpi.h])
AC_TRY_COMPILE([#include ],[],[AC_MSG_RESULT(yes)], [MPILIBS=""
AC_MSG_RESULT(no)])
fi],
[C++], [if test x != x"$MPILIBS"; then
AC_MSG_CHECKING([for mpi.h])
AC_TRY_COMPILE([#include ],[],[AC_MSG_RESULT(yes)], [MPILIBS=""
AC_MSG_RESULT(no)])
fi],
[Fortran 77], [if test x != x"$MPILIBS"; then
AC_MSG_CHECKING([for mpif.h])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([],[ include 'mpif.h'])],[AC_MSG_RESULT(yes)], [MPILIBS=""
AC_MSG_RESULT(no)])
fi],
[Fortran], [if test x != x"$MPILIBS"; then
AC_MSG_CHECKING([for mpif.h])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([],[ include 'mpif.h'])],[AC_MSG_RESULT(yes)], [MPILIBS=""
AC_MSG_RESULT(no)])
fi])
AC_LANG_CASE([C], [CC="$ax_mpi_save_CC"],
[C++], [CXX="$ax_mpi_save_CXX"],
[Fortran 77], [F77="$ax_mpi_save_F77"],
[Fortran], [FC="$ax_mpi_save_FC"])
AC_SUBST(MPILIBS)
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x = x"$MPILIBS"; then
$2
:
else
ifelse([$1],,[AC_DEFINE(HAVE_MPI,1,[Define if you have the MPI library.])],[$1])
:
fi
])dnl AX_MPI
arpack-ng-3.1.5/Makefile.in 0000644 0001750 0001750 00000075136 12277667632 012407 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
@MPI_TRUE@am__append_1 = PARPACK
subdir = .
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/configure $(am__configure_deps) \
$(srcdir)/arpack.pc.in COPYING README TODO compile \
config.guess config.sub depcomp install-sh missing ltmain.sh
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \
configure.lineno config.status.lineno
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES = arpack.pc
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgconfigdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
am__DEPENDENCIES_1 =
libarpack_la_DEPENDENCIES = $(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_libarpack_la_OBJECTS =
libarpack_la_OBJECTS = $(am_libarpack_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
libarpack_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(libarpack_la_LDFLAGS) $(LDFLAGS) -o $@
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libarpack_la_SOURCES) $(nodist_EXTRA_libarpack_la_SOURCES)
DIST_SOURCES = $(libarpack_la_SOURCES)
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
DATA = $(pkgconfig_DATA)
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
cscope distdir dist dist-all distcheck
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
CSCOPE = cscope
DIST_SUBDIRS = UTIL SRC . TESTS EXAMPLES PARPACK
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
distdir = $(PACKAGE)-$(VERSION)
top_distdir = $(distdir)
am__remove_distdir = \
if test -d "$(distdir)"; then \
find "$(distdir)" -type d ! -perm -200 -exec chmod u+w {} ';' \
&& rm -rf "$(distdir)" \
|| { sleep 5 && rm -rf "$(distdir)"; }; \
else :; fi
am__post_remove_distdir = $(am__remove_distdir)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
DIST_ARCHIVES = $(distdir).tar.gz
GZIP_ENV = --best
DIST_TARGETS = dist-gzip
distuninstallcheck_listfiles = find . -type f -print
am__distuninstallcheck_listfiles = $(distuninstallcheck_listfiles) \
| sed 's|^\./|$(prefix)/|' | grep -v '$(infodir)/dir$$'
distcleancheck_listfiles = find . -type f -print
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = UTIL SRC . TESTS EXAMPLES $(am__append_1)
lib_LTLIBRARIES = libarpack.la
ACLOCAL_AMFLAGS = -I m4/
libarpack_la_SOURCES =
# Force libarpack to be linked with the Fortran compiler.
# The file dummy.f does not need to exist in the source tree.
nodist_EXTRA_libarpack_la_SOURCES = dummy.f
libarpack_la_LDFLAGS = -no-undefined -version-info 2:0
libarpack_la_LIBADD = \
$(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la \
$(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = README PARPACK_CHANGES CHANGES DOCUMENTS EXAMPLES VISUAL_STUDIO \
detect_arpack_bug.m4
# Pkgconfig directory
pkgconfigdir = $(libdir)/pkgconfig
# Files to install in Pkgconfig directory
pkgconfig_DATA = arpack.pc
all: all-recursive
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
am--refresh: Makefile
@:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \
$(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \
&& exit 0; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
echo ' $(SHELL) ./config.status'; \
$(SHELL) ./config.status;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
$(SHELL) ./config.status --recheck
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
$(am__cd) $(srcdir) && $(AUTOCONF)
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
$(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS)
$(am__aclocal_m4_deps):
arpack.pc: $(top_builddir)/config.status $(srcdir)/arpack.pc.in
cd $(top_builddir) && $(SHELL) ./config.status $@
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
@$(NORMAL_INSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
}
uninstall-libLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
done
clean-libLTLIBRARIES:
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
@list='$(lib_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libarpack.la: $(libarpack_la_OBJECTS) $(libarpack_la_DEPENDENCIES) $(EXTRA_libarpack_la_DEPENDENCIES)
$(AM_V_F77LD)$(libarpack_la_LINK) -rpath $(libdir) $(libarpack_la_OBJECTS) $(libarpack_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
distclean-libtool:
-rm -f libtool config.lt
install-pkgconfigDATA: $(pkgconfig_DATA)
@$(NORMAL_INSTALL)
@list='$(pkgconfig_DATA)'; test -n "$(pkgconfigdir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(pkgconfigdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(pkgconfigdir)" || exit 1; \
fi; \
for p in $$list; do \
if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
echo "$$d$$p"; \
done | $(am__base_list) | \
while read files; do \
echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(pkgconfigdir)'"; \
$(INSTALL_DATA) $$files "$(DESTDIR)$(pkgconfigdir)" || exit $$?; \
done
uninstall-pkgconfigDATA:
@$(NORMAL_UNINSTALL)
@list='$(pkgconfig_DATA)'; test -n "$(pkgconfigdir)" || list=; \
files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \
dir='$(DESTDIR)$(pkgconfigdir)'; $(am__uninstall_files_from_dir)
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscope: cscope.files
test ! -s cscope.files \
|| $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS)
clean-cscope:
-rm -f cscope.files
cscope.files: clean-cscope cscopelist
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
-rm -f cscope.out cscope.in.out cscope.po.out cscope.files
distdir: $(DISTFILES)
$(am__remove_distdir)
test -d "$(distdir)" || mkdir "$(distdir)"
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
-test -n "$(am__skip_mode_fix)" \
|| find "$(distdir)" -type d ! -perm -755 \
-exec chmod u+rwx,go+rx {} \; -o \
! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
! -type d ! -perm -400 -exec chmod a+r {} \; -o \
! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \
|| chmod -R a+r "$(distdir)"
dist-gzip: distdir
tardir=$(distdir) && $(am__tar) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).tar.gz
$(am__post_remove_distdir)
dist-bzip2: distdir
tardir=$(distdir) && $(am__tar) | BZIP2=$${BZIP2--9} bzip2 -c >$(distdir).tar.bz2
$(am__post_remove_distdir)
dist-lzip: distdir
tardir=$(distdir) && $(am__tar) | lzip -c $${LZIP_OPT--9} >$(distdir).tar.lz
$(am__post_remove_distdir)
dist-xz: distdir
tardir=$(distdir) && $(am__tar) | XZ_OPT=$${XZ_OPT--e} xz -c >$(distdir).tar.xz
$(am__post_remove_distdir)
dist-tarZ: distdir
@echo WARNING: "Support for shar distribution archives is" \
"deprecated." >&2
@echo WARNING: "It will be removed altogether in Automake 2.0" >&2
tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z
$(am__post_remove_distdir)
dist-shar: distdir
@echo WARNING: "Support for distribution archives compressed with" \
"legacy program 'compress' is deprecated." >&2
@echo WARNING: "It will be removed altogether in Automake 2.0" >&2
shar $(distdir) | GZIP=$(GZIP_ENV) gzip -c >$(distdir).shar.gz
$(am__post_remove_distdir)
dist-zip: distdir
-rm -f $(distdir).zip
zip -rq $(distdir).zip $(distdir)
$(am__post_remove_distdir)
dist dist-all:
$(MAKE) $(AM_MAKEFLAGS) $(DIST_TARGETS) am__post_remove_distdir='@:'
$(am__post_remove_distdir)
# This target untars the dist file and tries a VPATH configuration. Then
# it guarantees that the distribution is self-contained by making another
# tarfile.
distcheck: dist
case '$(DIST_ARCHIVES)' in \
*.tar.gz*) \
GZIP=$(GZIP_ENV) gzip -dc $(distdir).tar.gz | $(am__untar) ;;\
*.tar.bz2*) \
bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\
*.tar.lz*) \
lzip -dc $(distdir).tar.lz | $(am__untar) ;;\
*.tar.xz*) \
xz -dc $(distdir).tar.xz | $(am__untar) ;;\
*.tar.Z*) \
uncompress -c $(distdir).tar.Z | $(am__untar) ;;\
*.shar.gz*) \
GZIP=$(GZIP_ENV) gzip -dc $(distdir).shar.gz | unshar ;;\
*.zip*) \
unzip $(distdir).zip ;;\
esac
chmod -R a-w $(distdir)
chmod u+w $(distdir)
mkdir $(distdir)/_build $(distdir)/_inst
chmod a-w $(distdir)
test -d $(distdir)/_build || exit 0; \
dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \
&& dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \
&& am__cwd=`pwd` \
&& $(am__cd) $(distdir)/_build \
&& ../configure \
$(AM_DISTCHECK_CONFIGURE_FLAGS) \
$(DISTCHECK_CONFIGURE_FLAGS) \
--srcdir=.. --prefix="$$dc_install_base" \
&& $(MAKE) $(AM_MAKEFLAGS) \
&& $(MAKE) $(AM_MAKEFLAGS) dvi \
&& $(MAKE) $(AM_MAKEFLAGS) check \
&& $(MAKE) $(AM_MAKEFLAGS) install \
&& $(MAKE) $(AM_MAKEFLAGS) installcheck \
&& $(MAKE) $(AM_MAKEFLAGS) uninstall \
&& $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \
distuninstallcheck \
&& chmod -R a-w "$$dc_install_base" \
&& ({ \
(cd ../.. && umask 077 && mkdir "$$dc_destdir") \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \
&& $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \
distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \
} || { rm -rf "$$dc_destdir"; exit 1; }) \
&& rm -rf "$$dc_destdir" \
&& $(MAKE) $(AM_MAKEFLAGS) dist \
&& rm -rf $(DIST_ARCHIVES) \
&& $(MAKE) $(AM_MAKEFLAGS) distcleancheck \
&& cd "$$am__cwd" \
|| exit 1
$(am__post_remove_distdir)
@(echo "$(distdir) archives ready for distribution: "; \
list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \
sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x'
distuninstallcheck:
@test -n '$(distuninstallcheck_dir)' || { \
echo 'ERROR: trying to run $@ with an empty' \
'$$(distuninstallcheck_dir)' >&2; \
exit 1; \
}; \
$(am__cd) '$(distuninstallcheck_dir)' || { \
echo 'ERROR: cannot chdir into $(distuninstallcheck_dir)' >&2; \
exit 1; \
}; \
test `$(am__distuninstallcheck_listfiles) | wc -l` -eq 0 \
|| { echo "ERROR: files left after uninstall:" ; \
if test -n "$(DESTDIR)"; then \
echo " (check DESTDIR support)"; \
fi ; \
$(distuninstallcheck_listfiles) ; \
exit 1; } >&2
distcleancheck: distclean
@if test '$(srcdir)' = . ; then \
echo "ERROR: distcleancheck can only run from a VPATH build" ; \
exit 1 ; \
fi
@test `$(distcleancheck_listfiles) | wc -l` -eq 0 \
|| { echo "ERROR: files left in build directory after distclean:" ; \
$(distcleancheck_listfiles) ; \
exit 1; } >&2
check-am: all-am
check: check-recursive
all-am: Makefile $(LTLIBRARIES) $(DATA)
installdirs: installdirs-recursive
installdirs-am:
for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgconfigdir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
mostlyclean-am
distclean: distclean-recursive
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-libtool distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am: install-pkgconfigDATA
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am: install-libLTLIBRARIES
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f $(am__CONFIG_DISTCLEAN_FILES)
-rm -rf $(top_srcdir)/autom4te.cache
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am: uninstall-libLTLIBRARIES uninstall-pkgconfigDATA
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am \
am--refresh check check-am clean clean-cscope clean-generic \
clean-libLTLIBRARIES clean-libtool cscope cscopelist-am ctags \
ctags-am dist dist-all dist-bzip2 dist-gzip dist-lzip \
dist-shar dist-tarZ dist-xz dist-zip distcheck distclean \
distclean-compile distclean-generic distclean-libtool \
distclean-tags distcleancheck distdir distuninstallcheck dvi \
dvi-am html html-am info info-am install install-am \
install-data install-data-am install-dvi install-dvi-am \
install-exec install-exec-am install-html install-html-am \
install-info install-info-am install-libLTLIBRARIES \
install-man install-pdf install-pdf-am install-pkgconfigDATA \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs installdirs-am maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am uninstall-libLTLIBRARIES \
uninstall-pkgconfigDATA
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/DOCUMENTS/ 0000755 0001750 0001750 00000000000 12277373057 011742 5 0000000 0000000 arpack-ng-3.1.5/DOCUMENTS/stat.doc 0000644 0001750 0001750 00000006552 12277373057 013334 0000000 0000000 c-----------------------------------------------------------------------
c
c Include this file to get timing statistics for the different parts
c of the Arnoldi update iteration. An easy way to initialize all the
c timing information to zero at the beginning is by:
c
c call sstats <-- symmetric code
c call sstatn <-- nonsymmetric code
c call cstatn <-- complex code
c
c-----------------------------------------------------------------------
c
c nopx = total number of user OP*x operation
c nbx = total number of user B*x operation (same as copy when B = I)
c nrorth = total number of reorthogonalization steps taken
c nitref = total number of it. refinement steps in reorthogonalization
c nrstrt = total number of restart steps
c
c-----------------------------------------------------------------------
c
c========================================================
c=== Common to both symmetric and nonsymmetric code ===
c========================================================
c
c tgetv0 = total time spent in generating starting vector and
c restarted vector for the Arnoldi sequence.
c titref = total time spent in iterative refinement phase in SSAITR.
c trvec = total time spent in computing the Ritz vectors before exit.
c
c====================================
c=== Specific to symmetric code ===
c====================================
c
c tsaupd = total time spent in SSAUPD.
c tsaup2 = total time spent in SSAUP2.
c tsaitr = total time spent in the basic Arnoldi iteration loop,
c including iterative refinement in SSAITR.
c tseigt = total time spent in computing the tridiagonal eigenvalue
c subproblem at each iteration.
c tsgets = total time spent in getting the shifts at each iteration.
c tsapps = total time spent in applying the shifts at each iteration.
c tsconv = total time spent in convergence test at each iteration.
c
c=======================================
c=== Specific to nonsymmetric code ===
c=======================================
c
c tnaupd = total time spent in SNAUPD.
c tnaup2 = total time spent in SNAUP2.
c tnaitr = total time spent in the basic Arnoldi iteration loop,
c including iterative refinement in SNAITR.
c tneigh = total time spent in computing the Hessenberg eigenvalue
c subproblem at each iteration.
c tngets = total time spent in getting the shifts at each iteration.
c tnapps = total time spent in applying the shifts at each iteration.
c tnconv = total time spent in convergence test at each iteration.
c
c==================================
c=== Specific to complex code ===
c==================================
c
c tcaupd = total time spent in CNAUPD.
c tcaup2 = total time spent in CNAUP2.
c tcaitr = total time spent in the basic Arnoldi iteration loop,
c including iterative refinement in CNAITR.
c tceigh = total time spent in computing the Hessenberg eigenvalue
c subproblem at each iteration.
c tcgets = total time spent in getting the shifts at each iteration.
c tcapps = total time spent in applying the shifts at each iteration.
c tcconv = total time spent in convergence test at each iteration.
c
c==================
c=== User time ===
c==================
c
c tmvopx = total time spent in computing Y = OP * X
c tmvbx = total time spent in computing Y = B * X
c
c=======================================================================
c
arpack-ng-3.1.5/DOCUMENTS/README 0000644 0001750 0001750 00000001067 12277373057 012546 0000000 0000000
There are five documents within the DOCUMENT subdirectory.
In summary,
ex-nonsym.doc, ex-sym.doc and ex-complex.doc
------------- ---------- --------------
Example Templates of how to invoke the different computational
modes offered by [D,S]NAUPD, [D,S]SAUPD and [C,Z]NAUPD.
stat.doc
--------
File that gets timing statistics for the different parts
of the Arnoldi update iteration codes within ARPACK.
debug.doc
---------
File that explains the different printing options of the
Arnoldi update iteration codes within ARPACK.
arpack-ng-3.1.5/DOCUMENTS/ex-sym.doc 0000644 0001750 0001750 00000021205 12277373057 013573 0000000 0000000 c-----------------------------------------------------------------------
c
c\Example-1
c ... Suppose want to solve A*x = lambda*x in regular mode
c ... so OP = A and B = I.
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 1
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... Call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c
c stop
c end
c
c\Example-2
c ... Suppose want to solve A*x = lambda*x in shift-invert mode
c ... so OP = inv[A - sigma*I] and B = I.
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*I]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call solve (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... Call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c
c\Example-3
c ... Suppose want to solve A*x = lambda*M*x in regular mode
c ... so OP = inv[M]*A and B = M.
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume "call solveM(n,rhs,x)" solves M*x = rhs
c ... Assume user will supplied shifts
c ...
c ido = 0
c iparam(7) = 2
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), temp_array)
c call _scopy (n, temp_array, 1, workd(ipntr(1)), 1)
c call solveM (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c
c ... delete this last conditional if want to use exact shifts
c else if (ido .eq. 3) then
c ... compute shifts and put in the first np locations of work
c np = iparam(8)
c call _copy (np, shifts, 1, workl(ipntr(11), 1)
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c stop
c end
c
c\Example-4
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
c ... so OP = (inv[A - sigma*M])*M and B = M.
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), temp_array)
c call solve (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c
c stop
c end
c
c\Example-5
c ... Suppose want to solve K*x = lambda*KG*x in Buckling mode
c ... so OP = (inv[K - sigma*KG])*K and B = K.
c ... Assume "call matvecM(n,x,y)" computes y = KG*x
c ... Assume "call matvecA(n,x,y)" computes y = K*x
c ... Assume "call solve(n,rhs,x)" solves [K - sigma*KG]*x = rhs
c ... Assume exact shifts are used
c
c ido = 0
c iparam(7) = 4
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecA (n, workd(ipntr(1)), temp_array)
c solve (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c stop
c end
c
c\Example-6
c ... Suppose want to solve A*x = lambda*M*x in Cayley mode
c ... so OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 5
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c call matvecA (n, workd(ipntr(1)), temp_array)
c call _axpy (n, sigma, workd(inptr(2)), 1, temp_array, 1)
c call solve (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
c call _axpy (n, sigma, workd(inptr(3)), 1, workd(ipntr(2)), 1)
c call _copy (n, workd(inptr(2)), 1, workd(ipntr(3)), 1)
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _seupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
c & ipntr, workd, workl, lworkl, info )
c stop
c end
c\EndDoc
c
arpack-ng-3.1.5/DOCUMENTS/ex-complex.doc 0000644 0001750 0001750 00000013070 12277373057 014433 0000000 0000000 c-----------------------------------------------------------------------
c
c\Example-1
c ... Suppose want to solve A*x = lambda*x in regular mode
c ... so OP = A and B = I.
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 1
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, rwork, info )
c stop
c end
c
c\Example-2
c ... Suppose want to solve A*x = lambda*x in shift-invert mode
c ... so OP = inv[A - sigma*I] and B = I
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*I]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iaparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call solve (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, rwork, info )
c stop
c end
c
c\Example-3
c ... Suppose want to solve A*x = lambda*M*x in regular mode
c ... so OP = inv[M]*A and B = M.
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume "call solveM(n,rhs,x)" solves M*x = rhs
c ... Assume user will supplied shifts
c ...
c ido = 0
c iparam(7) = 2
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), temp_array)
c call solveM (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c
c ... delete this last conditional if want to use exact shifts
c else if (ido .eq. 3) then
c ... compute shifts and put in workl starting from the position
c ... pointed by ipntr(14).
c np = iparam(8)
c call scopy (np, shifts, 1, workl(ipntr(14), 1)
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, rwork, info )
c stop
c end
c
c\Example-4
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
c ... so OP = inv[A - sigma*M]*M and B = M
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), temp_array)
c call solve (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, rwork, info )
c stop
c end
c\EndDoc
arpack-ng-3.1.5/DOCUMENTS/ex-nonsym.doc 0000644 0001750 0001750 00000022412 12277373057 014307 0000000 0000000 c-----------------------------------------------------------------------
c
c\Example-1
c ... Suppose want to solve A*x = lambda*x in regular mode
c ... so OP = A and B = I.
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 1
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c stop
c end
c
c\Example-2
c ... Suppose want to solve A*x = lambda*x in shift-invert mode
c ... so OP = inv[A - sigma*I] and B = I, sigma has zero
c ... imaginary part
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*I]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iaparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call solve (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c stop
c end
c
c\Example-3
c ... Suppose want to solve A*x = lambda*M*x in regular mode
c ... so OP = inv[M]*A and B = M.
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call matvecA(n,x,y)" computes y = A*x
c ... Assume "call solveM(n,rhs,x)" solves M*x = rhs
c ... Assume user will supplied shifts
c ...
c ido = 0
c iparam(7) = 2
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1 .or. ido .eq. 1) then
c call matvecA (n, workd(ipntr(1)), temp_array)
c call solveM (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c
c ... delete this last conditional if want to use exact shifts
c else if (ido .eq. 3) then
c ... compute shifts and put in workl starting from the position
c ... pointed by ipntr(14).
c np = iparam(8)
c call scopy (np, shifts, 1, workl(ipntr(14), 1)
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c stop
c end
c
c\Example-4
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
c ... so OP = inv[A - sigma*M]*M and B = M, sigma has zero
c ... imaginary part
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), temp_array)
c call solve (n, temp_array, workd(ipntr(2)))
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c stop
c end
c
c\Example-5
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
c ... So OP = Real_Part{inv[A-SIGMA*M]*M and B=M, sigma has
c ... nonzero imaginary part
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... in complex arithmetic
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), temp_array)
c call solve(n, temp_array, complex_array)
c do i = 1, n
c workd(ipntr(2)+i-1) = real(complex_array(i))
c end do
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), complex_array)
c do i = 1, n
c workd(ipntr(2)+i-1) = real(complex_array(i))
c end do
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess.
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c ... Use Rayleigh quotient to transform d(:,1) and d(:,2)
c to the approximation to the original problem.
c stop
c end
c
c\Example-6
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
c ... So OP = Imaginary_Part{inv[A-SIGMA*M]*M and B=M, sigma must
c ... have nonzero imaginary part
c ... Assume "call matvecM(n,x,y)" computes y = M*x
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
c ... in complex arithmetic
c ... Assume exact shifts are used
c ...
c ido = 0
c iparam(7) = 3
c
c %------------------------------------%
c | Beginning of reverse communication |
c %------------------------------------%
c 10 continue
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
c & iparam, ipntr, workd, workl, lworkl, info )
c if (ido .eq. -1) then
c call matvecM (n, workd(ipntr(1)), temp_array)
c call solve(n, temp_array, complex_array)
c do i = 1, n
c workd(ipntr(2)+i-1) = aimag(complex_array(i))
c end do
c go to 10
c else if (ido .eq. 1) then
c call solve (n, workd(ipntr(3)), complex_array)
c do i = 1, n
c workd(ipntr(2)+i-1) = aimag(complex_array(i))
c end do
c go to 10
c else if (ido .eq. 2) then
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
c go to 10
c end if
c %------------------------------%
c | End of Reverse communication |
c %------------------------------%
c
c ... call _neupd to postprocess
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
c & lworkl, info )
c ... Use Rayleigh quotient to transform d(:,1) and d(:,2)
c to the Ritz approximation to the original problem.
c stop
c end
c
c\EndDoc
arpack-ng-3.1.5/DOCUMENTS/debug.doc 0000644 0001750 0001750 00000041035 12277373057 013442 0000000 0000000 ARPACK provides a means to trace the progress of the computation
as it proceeds. Various levels of output may be specified
from no output, level = 0, to voluminous, level = 3.
The following statements may be used within the calling program to
initiate and request this output.
include 'debug.h'
ndigit = -3
logfil = 6
msgets = 0
msaitr = 0
msapps = 0
msaupd = 1
msaup2 = 0
mseigt = 0
mseupd = 0
The parameter "logfil" specifies the logical unit number of the output
file. The parameter "ndigit" specifies the number of decimal digits
and the width of the output lines. A positive value of "ndigit"
specifies that 132 columns are used during output and a negative
value specifies eighty columns are to be used. The values of the remaining
parameters indicate the output levels from the indicated routines.
For the above example, "msaitr" indicates the level of output requested
for the subroutine ssaitr or dsaitr. The above configuration will
give a breakdown of the number of matrix vector products required,
the total number of iterations, the number of re-orthogonalization
steps and an estimate of the time spent in each routine and phase of the
computation. The following output is produced:
---------------------------------------------------------------------
==========================================
= Symmetric implicit Arnoldi update code =
= Version Number: 2.1 =
= Version Date: 11/15/95 =
==========================================
= Summary of timing statistics =
==========================================
Total number update iterations = 8
Total number of OP*x operations = 125
Total number of B*x operations = 0
Total number of reorthogonalization steps = 125
Total number of iterative refinement steps = 0
Total number of restart steps = 0
Total time in user OP*x operation = 0.020002
Total time in user B*x operation = 0.000000
Total time in Arnoldi update routine = 0.210021
Total time in ssaup2 routine = 0.190019
Total time in basic Arnoldi iteration loop = 0.110011
Total time in reorthogonalization phase = 0.070007
Total time in (re)start vector generation = 0.000000
Total time in trid eigenvalue subproblem = 0.040004
Total time in getting the shifts = 0.000000
Total time in applying the shifts = 0.040004
Total time in convergence testing = 0.000000
---------------------------------------------------------------------
The user is encouraged to experiment with the other settings
once some familiarity has been gained with the routines.
The include statement sets up the storage declarations that are
solely associated with this trace debugging feature. "debug.h"
has the following structure:
---------------------------------------------------------------------
c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
---------------------------------------------------------------------
The parameters "msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd"
are for the symmetric codes, while
"mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd" are for the
nonsymmetric codes and, finally,
"mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd" are for the complex
arithmetic codes. A comprehensive break down of each parameter is given
below.
==========================================================
=== Common to symmetric, nonsymmetric and complex code ===
==========================================================
logfil: unit number where the logfile (debug) is written
ndigit: number of digits used in the debug output
ndigit < 0: printing is done with 72 columns.
ndigit > 0: printing is done with 132 columns.
mgetv0 > 0: print residual vector generated.
======================================
=== Specific to the symmetric code ===
======================================
msaupd > 0: *Print the number of iterations taken,
number of "converged" eigenvalues,
final Ritz values and corresponding Ritz estimates.
*Print various timing statistics.
msaup2 > 0: *Print major iteration number,
number of "converged" Ritz values on exit,
B-norm of the residual vector of length NCV factorization,
B-norm of the residual vector of length NEV factorization,
residual norm before exit,
Ritz values and corresponding Ritz estimates before exit.
msaup2 > 1: print number of unreduced submatrices,
Ritz values and corresponding Ritz estimates of the current
T matrix, actual values for NEV and NP,
wanted Ritz values and corresponding Ritz estimates,
shifts selected.
msaup2 > 2: print "unwanted" Ritz values and corresponding Ritz
estimates, order NCV matrix T (diagonal and off-diagonal),
unwanted Ritz values and error bounds.
msaitr > 0: print iteration number, residual norm, restart info
print if an off diagonal element of T became negative.
msaitr > 1: print the final matrix T.
msaitr > 2: print Arnoldi vector no. generate at iteration j,
b-norm of residual vector at each iteration,
print rnorm and rnorm1 for iterative refinement,
print wnorm and rnorm used for Re-orthogonalization,
V^T * B * (resid/B-norm(resid)),
print the results of whether the current residual vector is
orthogonal to the current Lanczos basis.
msaitr > 3: print the matrix T at each iteration.
print the residual vector and arnoldi vectors.
mseigt > 0: print the current matrix T.
msgets > 0: print NEV and NP,
eigenvalues of and corresponding Ritz estimates of the
current T matrix.
msapps > 0: print information about deflation at row/column no.
msapps > 1: print initial matrix T
print sigmak, betak and matrix T after all shifts
msapps > 2: print the matrix T after the application of each shift.
msapps > 3: updated residual for next iteration.
mseupd > 1: print eigenvalues of the final T matrix,
the last row of the eigenvector matrix for T,
if reordered, reordered last row of the eigenvector matrix,
reordered NCV Ritz values of the final T matrix,
if type = 'REGULAR', untransformed "converged" Ritz values
and corresponding Ritz estimates,
NCV Ritz values of the final T matrix,
last row of the eigenvector matrix for T,
if reordered, reordered last row of the eigenvector matrix,
reordered NCV Ritz values of the final T.
mseupd > 2: print the matrix T.
=========================================
=== Specific to the nonsymmetric code ===
=========================================
mnaupd > 0: *Print the number of iterations taken,
number of "converged" eigenvalues,
real and imaginary parts of the converged Ritz values
and their corresponding Ritz estimates,
*Print various timing statistics.
mnaup2 > 0: *Print major iteration number.
*Print the number of "converged" Ritz values on exit,
and the real and imaginary parts of the "converged" Ritz
values and corresponding Ritz estimates.
mnaup2 > 1: *Print the length of the Arnoldi Factorization,
and the B-norm of its residual vector.
*Print NEV and NP, real and imaginary parts of the "wanted"
Ritz values and associated Ritz estimates at each
iteration.
*Print the B-norm of the residual of the compressed
factorization and the compressed upper Hessenberg matrix H.
mnaup2 > 2: *Print the real and imaginary parts of all the Ritz values
and associated Ritz estimates, NEV, NP, NUMCNV, NCONV.
*Print the real and imaginary parts of the shifts. If the
exact shift strategy is used, print the associated Ritz
estimates of the shifts.
*Print the real and imaginary parts of the Ritz values
and the corresponding Ritz estimates obtained from _neigh.
mnaitr > 0: *Print if a restart is needed.
mnaitr > 1: *Print the number of Arnoldi vector being generated and
the B-norm of the current residual.
mnaitr > 2: *Print j-th column of the Hessenberg matrix H.
*Print reorthogonalization and iterative refinement information,
*Print the final upper Hessenberg matrix of order K+NEV.
mnaitr > 3: *Print V^T*B*resid/(B-norm(resid)).
mnaitr > 4: *Print current upper Hessenberg matrix.
mnaitr > 5: *Print updated arnoldi vectors and the residual vector.
mneigh > 1: *Print the last row of the Schur matrix for H, and
the last row of the eigenvector matrix for H.
mneigh > 2: *Print the entering upper Hessenberg matrix.
*Print the real and imaginary part of eigenvalues
of the current Hessenberg matrix, and associated
Ritz estimates.
mngets > 0: *Print the real and imaginary parts of the Ritz values
of the Hessenberg matrix and their the corresponding
error bounds, KEV, NP.
mnapps > 0: *Print information about where deflation occured.
mnapps > 1: *Print sigmak, betak, order of the final Hessenberg matrix,
and the final compressed upper Hessenberg matrix.
mnapps > 2: *Print implicit application of shift number, real and imaginary
part of the shift.
*Print the indices of the submatrix that the shift is applied.
mnapps > 3: *Print the matrix H before and after the application of
each shift, updated residual for next iteration.
mnapps > 4: *Print the accumulated orthogonal Hessenberg matrix Q,
updated matrix of Arnoldi vectors.
mneupd > 0: *Print the number of converged Ritz values, B-norm of the
residual, all NCV Ritz values and error bounds.
mneupd > 1: *Print the final upper Hessenberg matrix computed by _naupd.
*If Ritz vectors are requested, print real and imaginary parts
of the eigenvalues and the last row of the Schur vectors as
computed by _neupd.
mneupd > 2: *If Ritz vectors are requested, print the threshold eigenvalue
used for re-ordering.
*If Ritz vectors are requested, print the number of eigenvalues
to reorder and the number of converged Ritz values.
*If Ritz vectors are requested, print the upper quasi-matrix
computed by _neupd.
*If Ritz vectors are requested, print the real and imaginary
part of the Ritz values.
*If Ritz vectors are requested, print the last row of the
eigenvector matrix.
*Print the NCV Ritz estimates in the original system.
mneupd > 3: *Print the integer array of pointers.
*If Ritz vectors are requested, print the eigenvector matrix.
*If Ritz vectors are requested, print the reordered upper
quasi-triangular matrix.
mneupd > 4: *If Ritz vectors are requested, print the Q matrix of the QR
factorization of the matrix representing the wanted invariant
subspace.
*If Ritz vectors are requested, print the Schur vectors.
*If Ritz vectors are requested, print the reordered Schur vectors.
====================================
=== Specific to the complex code ===
====================================
mcaupd > 0: *Print the number of iterations taken,
number of "converged" eigenvalues, the converged Ritz values
and their corresponding Ritz estimates,
*Print various timing statistics.
mcaup2 > 0: *Print major iteration number.
*Print the number of "converged" Ritz values on exit, and the
"converged" Ritz values and corresponding Ritz estimates.
mcaup2 > 1: *Print the length of the Arnoldi Factorization,
and the B-norm of its residual vector.
*Print NEV and NP, the "wanted" Ritz values and associated Ritz
estimates at each iteration.
*Print the B-norm of the residual of the compressed
factorization and the compressed upper Hessenberg matrix H.
mcaup2 > 2: *Print the all the Ritz values and associated Ritz estimates,
NEV, NP, NUMCNV, NCONV.
*Print the shifts. If the exact shift strategy is used, print the
associated Ritz estimates of the shifts.
*Print the Ritz values and the corresponding Ritz estimates obtained
from _neigh.
mcaitr > 0: *Print if a restart is needed.
mcaitr > 1: *Print the number of Arnoldi vector being generated and
the B-norm of the current residual.
mcaitr > 2: *Print j-th column of the Hessenberg matrix H.
*Print reorthogonalization and iterative refinement information,
*Print the final upper Hessenberg matrix of order K+NEV.
mcaitr > 3: *Print V^T*B*resid/(B-norm(resid)).
mcaitr > 4: *Print current upper Hessenberg matrix.
mcaitr > 5: *Print updated Arnoldi vectors and the residual vector.
mceigh > 1: *Print the last row of the Schur matrix for H, and
the last row of the eigenvector matrix for H.
mceigh > 2: *Print the entering upper Hessenberg matrix.
*Print the eigenvalues of the current Hessenberg matrix, and
associated Ritz estimates.
mcgets > 0: *Print the real and imaginary parts of the Ritz values
of the Hessenberg matrix and their the corresponding
error bounds, KEV, NP.
mcapps > 0: *Print information about where deflation occured.
mcapps > 1: *Print sigmak, betak, order of the final Hessenberg matrix,
and the final compressed upper Hessenberg matrix.
mcapps > 2: *Print implicit application of shift number, the shift.
*Print the indices of the submatrix that the shift is applied.
mcapps > 3: *Print the matrix H before and after the application of
each shift, updated residual for next iteration.
mcapps > 4: *Print the accumulated unitary Hessenberg matrix Q, and the
updated matrix of Arnoldi vectors.
mceupd > 0: *Print the number of converged Ritz values, B-norm of the
residual, all NCV Ritz values and error bounds.
mceupd > 1: *Print the final upper Hessenberg matrix computed by _naupd.
*If Ritz vectors are requested, print the eigenvalues and the
last row of the Schur vectors as computed by _neupd.
mceupd > 2: *If Ritz vectors are requested, print the threshold eigenvalue
used for re-ordering.
*If Ritz vectors are requested, print the number of eigenvalues
to reorder and the number of converged Ritz values.
*If Ritz vectors are requested, print the upper quasi-matrix
computed by _neupd.
*If Ritz vectors are requested, print the Ritz values.
*If Ritz vectors are requested, print the last row of the
eigenvector matrix.
*Print the NCV Ritz estimates in the original system.
mceupd > 3: *Print the integer array of pointers.
*If Ritz vectors are requested, print the eigenvector matrix.
mceupd > 4: *If Ritz vectors are requested, print the Q matrix of the QR
factorization of the matrix representing the wanted invariant
subspace.
*If Ritz vectors are requested, print the Schur vectors.
arpack-ng-3.1.5/depcomp 0000755 0001750 0001750 00000044267 12277373057 011713 0000000 0000000 #! /bin/sh
# depcomp - compile a program generating dependencies as side-effects
scriptversion=2009-04-28.21; # UTC
# Copyright (C) 1999, 2000, 2003, 2004, 2005, 2006, 2007, 2009 Free
# Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# Originally written by Alexandre Oliva .
case $1 in
'')
echo "$0: No command. Try \`$0 --help' for more information." 1>&2
exit 1;
;;
-h | --h*)
cat <<\EOF
Usage: depcomp [--help] [--version] PROGRAM [ARGS]
Run PROGRAMS ARGS to compile a file, generating dependencies
as side-effects.
Environment variables:
depmode Dependency tracking mode.
source Source file read by `PROGRAMS ARGS'.
object Object file output by `PROGRAMS ARGS'.
DEPDIR directory where to store dependencies.
depfile Dependency file to output.
tmpdepfile Temporary file to use when outputing dependencies.
libtool Whether libtool is used (yes/no).
Report bugs to .
EOF
exit $?
;;
-v | --v*)
echo "depcomp $scriptversion"
exit $?
;;
esac
if test -z "$depmode" || test -z "$source" || test -z "$object"; then
echo "depcomp: Variables source, object and depmode must be set" 1>&2
exit 1
fi
# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po.
depfile=${depfile-`echo "$object" |
sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`}
tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`}
rm -f "$tmpdepfile"
# Some modes work just like other modes, but use different flags. We
# parameterize here, but still list the modes in the big case below,
# to make depend.m4 easier to write. Note that we *cannot* use a case
# here, because this file can only contain one case statement.
if test "$depmode" = hp; then
# HP compiler uses -M and no extra arg.
gccflag=-M
depmode=gcc
fi
if test "$depmode" = dashXmstdout; then
# This is just like dashmstdout with a different argument.
dashmflag=-xM
depmode=dashmstdout
fi
cygpath_u="cygpath -u -f -"
if test "$depmode" = msvcmsys; then
# This is just like msvisualcpp but w/o cygpath translation.
# Just convert the backslash-escaped backslashes to single forward
# slashes to satisfy depend.m4
cygpath_u="sed s,\\\\\\\\,/,g"
depmode=msvisualcpp
fi
case "$depmode" in
gcc3)
## gcc 3 implements dependency tracking that does exactly what
## we want. Yay! Note: for some reason libtool 1.4 doesn't like
## it if -MD -MP comes after the -MF stuff. Hmm.
## Unfortunately, FreeBSD c89 acceptance of flags depends upon
## the command line argument order; so add the flags where they
## appear in depend2.am. Note that the slowdown incurred here
## affects only configure: in makefiles, %FASTDEP% shortcuts this.
for arg
do
case $arg in
-c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;;
*) set fnord "$@" "$arg" ;;
esac
shift # fnord
shift # $arg
done
"$@"
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile"
exit $stat
fi
mv "$tmpdepfile" "$depfile"
;;
gcc)
## There are various ways to get dependency output from gcc. Here's
## why we pick this rather obscure method:
## - Don't want to use -MD because we'd like the dependencies to end
## up in a subdir. Having to rename by hand is ugly.
## (We might end up doing this anyway to support other compilers.)
## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like
## -MM, not -M (despite what the docs say).
## - Using -M directly means running the compiler twice (even worse
## than renaming).
if test -z "$gccflag"; then
gccflag=-MD,
fi
"$@" -Wp,"$gccflag$tmpdepfile"
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
echo "$object : \\" > "$depfile"
alpha=ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz
## The second -e expression handles DOS-style file names with drive letters.
sed -e 's/^[^:]*: / /' \
-e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile"
## This next piece of magic avoids the `deleted header file' problem.
## The problem is that when a header file which appears in a .P file
## is deleted, the dependency causes make to die (because there is
## typically no way to rebuild the header). We avoid this by adding
## dummy dependencies for each header file. Too bad gcc doesn't do
## this for us directly.
tr ' ' '
' < "$tmpdepfile" |
## Some versions of gcc put a space before the `:'. On the theory
## that the space means something, we add a space to the output as
## well.
## Some versions of the HPUX 10.20 sed can't process this invocation
## correctly. Breaking it into two sed invocations is a workaround.
sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
hp)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
sgi)
if test "$libtool" = yes; then
"$@" "-Wp,-MDupdate,$tmpdepfile"
else
"$@" -MDupdate "$tmpdepfile"
fi
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files
echo "$object : \\" > "$depfile"
# Clip off the initial element (the dependent). Don't try to be
# clever and replace this with sed code, as IRIX sed won't handle
# lines with more than a fixed number of characters (4096 in
# IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines;
# the IRIX cc adds comments like `#:fec' to the end of the
# dependency line.
tr ' ' '
' < "$tmpdepfile" \
| sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' | \
tr '
' ' ' >> "$depfile"
echo >> "$depfile"
# The second pass generates a dummy entry for each header file.
tr ' ' '
' < "$tmpdepfile" \
| sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \
>> "$depfile"
else
# The sourcefile does not contain any dependencies, so just
# store a dummy comment line, to avoid errors with the Makefile
# "include basename.Plo" scheme.
echo "#dummy" > "$depfile"
fi
rm -f "$tmpdepfile"
;;
aix)
# The C for AIX Compiler uses -M and outputs the dependencies
# in a .u file. In older versions, this file always lives in the
# current directory. Also, the AIX compiler puts `$object:' at the
# start of each line; $object doesn't have directory information.
# Version 6 uses the directory in both cases.
dir=`echo "$object" | sed -e 's|/[^/]*$|/|'`
test "x$dir" = "x$object" && dir=
base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'`
if test "$libtool" = yes; then
tmpdepfile1=$dir$base.u
tmpdepfile2=$base.u
tmpdepfile3=$dir.libs/$base.u
"$@" -Wc,-M
else
tmpdepfile1=$dir$base.u
tmpdepfile2=$dir$base.u
tmpdepfile3=$dir$base.u
"$@" -M
fi
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3"
do
test -f "$tmpdepfile" && break
done
if test -f "$tmpdepfile"; then
# Each line is of the form `foo.o: dependent.h'.
# Do two passes, one to just change these to
# `$object: dependent.h' and one to simply `dependent.h:'.
sed -e "s,^.*\.[a-z]*:,$object:," < "$tmpdepfile" > "$depfile"
# That's a tab and a space in the [].
sed -e 's,^.*\.[a-z]*:[ ]*,,' -e 's,$,:,' < "$tmpdepfile" >> "$depfile"
else
# The sourcefile does not contain any dependencies, so just
# store a dummy comment line, to avoid errors with the Makefile
# "include basename.Plo" scheme.
echo "#dummy" > "$depfile"
fi
rm -f "$tmpdepfile"
;;
icc)
# Intel's C compiler understands `-MD -MF file'. However on
# icc -MD -MF foo.d -c -o sub/foo.o sub/foo.c
# ICC 7.0 will fill foo.d with something like
# foo.o: sub/foo.c
# foo.o: sub/foo.h
# which is wrong. We want:
# sub/foo.o: sub/foo.c
# sub/foo.o: sub/foo.h
# sub/foo.c:
# sub/foo.h:
# ICC 7.1 will output
# foo.o: sub/foo.c sub/foo.h
# and will wrap long lines using \ :
# foo.o: sub/foo.c ... \
# sub/foo.h ... \
# ...
"$@" -MD -MF "$tmpdepfile"
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile"
exit $stat
fi
rm -f "$depfile"
# Each line is of the form `foo.o: dependent.h',
# or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'.
# Do two passes, one to just change these to
# `$object: dependent.h' and one to simply `dependent.h:'.
sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile"
# Some versions of the HPUX 10.20 sed can't process this invocation
# correctly. Breaking it into two sed invocations is a workaround.
sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" |
sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
hp2)
# The "hp" stanza above does not work with aCC (C++) and HP's ia64
# compilers, which have integrated preprocessors. The correct option
# to use with these is +Maked; it writes dependencies to a file named
# 'foo.d', which lands next to the object file, wherever that
# happens to be.
# Much of this is similar to the tru64 case; see comments there.
dir=`echo "$object" | sed -e 's|/[^/]*$|/|'`
test "x$dir" = "x$object" && dir=
base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'`
if test "$libtool" = yes; then
tmpdepfile1=$dir$base.d
tmpdepfile2=$dir.libs/$base.d
"$@" -Wc,+Maked
else
tmpdepfile1=$dir$base.d
tmpdepfile2=$dir$base.d
"$@" +Maked
fi
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile1" "$tmpdepfile2"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2"
do
test -f "$tmpdepfile" && break
done
if test -f "$tmpdepfile"; then
sed -e "s,^.*\.[a-z]*:,$object:," "$tmpdepfile" > "$depfile"
# Add `dependent.h:' lines.
sed -ne '2,${
s/^ *//
s/ \\*$//
s/$/:/
p
}' "$tmpdepfile" >> "$depfile"
else
echo "#dummy" > "$depfile"
fi
rm -f "$tmpdepfile" "$tmpdepfile2"
;;
tru64)
# The Tru64 compiler uses -MD to generate dependencies as a side
# effect. `cc -MD -o foo.o ...' puts the dependencies into `foo.o.d'.
# At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put
# dependencies in `foo.d' instead, so we check for that too.
# Subdirectories are respected.
dir=`echo "$object" | sed -e 's|/[^/]*$|/|'`
test "x$dir" = "x$object" && dir=
base=`echo "$object" | sed -e 's|^.*/||' -e 's/\.o$//' -e 's/\.lo$//'`
if test "$libtool" = yes; then
# With Tru64 cc, shared objects can also be used to make a
# static library. This mechanism is used in libtool 1.4 series to
# handle both shared and static libraries in a single compilation.
# With libtool 1.4, dependencies were output in $dir.libs/$base.lo.d.
#
# With libtool 1.5 this exception was removed, and libtool now
# generates 2 separate objects for the 2 libraries. These two
# compilations output dependencies in $dir.libs/$base.o.d and
# in $dir$base.o.d. We have to check for both files, because
# one of the two compilations can be disabled. We should prefer
# $dir$base.o.d over $dir.libs/$base.o.d because the latter is
# automatically cleaned when .libs/ is deleted, while ignoring
# the former would cause a distcleancheck panic.
tmpdepfile1=$dir.libs/$base.lo.d # libtool 1.4
tmpdepfile2=$dir$base.o.d # libtool 1.5
tmpdepfile3=$dir.libs/$base.o.d # libtool 1.5
tmpdepfile4=$dir.libs/$base.d # Compaq CCC V6.2-504
"$@" -Wc,-MD
else
tmpdepfile1=$dir$base.o.d
tmpdepfile2=$dir$base.d
tmpdepfile3=$dir$base.d
tmpdepfile4=$dir$base.d
"$@" -MD
fi
stat=$?
if test $stat -eq 0; then :
else
rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" "$tmpdepfile4"
exit $stat
fi
for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" "$tmpdepfile4"
do
test -f "$tmpdepfile" && break
done
if test -f "$tmpdepfile"; then
sed -e "s,^.*\.[a-z]*:,$object:," < "$tmpdepfile" > "$depfile"
# That's a tab and a space in the [].
sed -e 's,^.*\.[a-z]*:[ ]*,,' -e 's,$,:,' < "$tmpdepfile" >> "$depfile"
else
echo "#dummy" > "$depfile"
fi
rm -f "$tmpdepfile"
;;
#nosideeffect)
# This comment above is used by automake to tell side-effect
# dependency tracking mechanisms from slower ones.
dashmstdout)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout, regardless of -o.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# Remove `-o $object'.
IFS=" "
for arg
do
case $arg in
-o)
shift
;;
$object)
shift
;;
*)
set fnord "$@" "$arg"
shift # fnord
shift # $arg
;;
esac
done
test -z "$dashmflag" && dashmflag=-M
# Require at least two characters before searching for `:'
# in the target name. This is to cope with DOS-style filenames:
# a dependency such as `c:/foo/bar' could be seen as target `c' otherwise.
"$@" $dashmflag |
sed 's:^[ ]*[^: ][^:][^:]*\:[ ]*:'"$object"'\: :' > "$tmpdepfile"
rm -f "$depfile"
cat < "$tmpdepfile" > "$depfile"
tr ' ' '
' < "$tmpdepfile" | \
## Some versions of the HPUX 10.20 sed can't process this invocation
## correctly. Breaking it into two sed invocations is a workaround.
sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
dashXmstdout)
# This case only exists to satisfy depend.m4. It is never actually
# run, as this mode is specially recognized in the preamble.
exit 1
;;
makedepend)
"$@" || exit $?
# Remove any Libtool call
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# X makedepend
shift
cleared=no eat=no
for arg
do
case $cleared in
no)
set ""; shift
cleared=yes ;;
esac
if test $eat = yes; then
eat=no
continue
fi
case "$arg" in
-D*|-I*)
set fnord "$@" "$arg"; shift ;;
# Strip any option that makedepend may not understand. Remove
# the object too, otherwise makedepend will parse it as a source file.
-arch)
eat=yes ;;
-*|$object)
;;
*)
set fnord "$@" "$arg"; shift ;;
esac
done
obj_suffix=`echo "$object" | sed 's/^.*\././'`
touch "$tmpdepfile"
${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@"
rm -f "$depfile"
cat < "$tmpdepfile" > "$depfile"
sed '1,2d' "$tmpdepfile" | tr ' ' '
' | \
## Some versions of the HPUX 10.20 sed can't process this invocation
## correctly. Breaking it into two sed invocations is a workaround.
sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
rm -f "$tmpdepfile" "$tmpdepfile".bak
;;
cpp)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
# Remove `-o $object'.
IFS=" "
for arg
do
case $arg in
-o)
shift
;;
$object)
shift
;;
*)
set fnord "$@" "$arg"
shift # fnord
shift # $arg
;;
esac
done
"$@" -E |
sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \
-e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' |
sed '$ s: \\$::' > "$tmpdepfile"
rm -f "$depfile"
echo "$object : \\" > "$depfile"
cat < "$tmpdepfile" >> "$depfile"
sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile"
rm -f "$tmpdepfile"
;;
msvisualcpp)
# Important note: in order to support this mode, a compiler *must*
# always write the preprocessed file to stdout.
"$@" || exit $?
# Remove the call to Libtool.
if test "$libtool" = yes; then
while test "X$1" != 'X--mode=compile'; do
shift
done
shift
fi
IFS=" "
for arg
do
case "$arg" in
-o)
shift
;;
$object)
shift
;;
"-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI")
set fnord "$@"
shift
shift
;;
*)
set fnord "$@" "$arg"
shift
shift
;;
esac
done
"$@" -E 2>/dev/null |
sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile"
rm -f "$depfile"
echo "$object : \\" > "$depfile"
sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s:: \1 \\:p' >> "$depfile"
echo " " >> "$depfile"
sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile"
rm -f "$tmpdepfile"
;;
msvcmsys)
# This case exists only to let depend.m4 do its work. It works by
# looking at the text of this script. This case will never be run,
# since it is checked for above.
exit 1
;;
none)
exec "$@"
;;
*)
echo "Unknown depmode $depmode" 1>&2
exit 1
;;
esac
exit 0
# Local Variables:
# mode: shell-script
# sh-indentation: 2
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
arpack-ng-3.1.5/TESTS/ 0000755 0001750 0001750 00000000000 12277671743 011306 5 0000000 0000000 arpack-ng-3.1.5/TESTS/debug.h 0000644 0001750 0001750 00000001351 12277373057 012462 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/TESTS/Makefile.am 0000644 0001750 0001750 00000000423 12277373057 013256 0000000 0000000 check_PROGRAMS = dnsimp bug_1323
dnsimp_SOURCES = dnsimp.f mmio.f debug.h
dnsimp_LDADD=../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = testA.mtx
bug_1323_SOURCES = bug_1323.f
bug_1323_LDADD=../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
TESTS = dnsimp bug_1323
arpack-ng-3.1.5/TESTS/mmio.f 0000644 0001750 0001750 00000071071 12277373057 012341 0000000 0000000 subroutine mmread(iunit,rep,field,symm,rows,cols,nnz,nnzmax,
* indx,jndx,ival,rval,cval)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c This routine will read data from a matrix market formatted file.
c The data may be either sparse coordinate format, or dense array format.
c
c The unit iunit must be open, and the file will be rewound on return.
c
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
c 18-Oct-96 Change in routine name to match C and Matlab routines.
c 30-Oct-96 Bug fixes in mmio.f:
c -looping for comment lines
c -fixed non-ansi zero stringlength
c -incorrect size calculation for skew-symmetric arrays
c Other changes in mmio.f:
c -added integer value parameter to calling sequences
c -enforced proper count in size info line
c -added routine to count words in string (countwd)
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
c of the initial version and suggested fixes.)
c 15-Oct-08 fixed illegal attempt of mimicking "do while" construct
c by redifing limits inside loop. (lines 443-450)
c (Thanks to Geraldo Veiga for his comments.)
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Arguments:
c
c name type in/out description
c ---------------------------------------------------------------
c
c iunit integer in Unit identifier for the file
c containing the data to be read.
c Must be open prior to call.
c Will be rewound on return.
c
c rep character*10 out Matrix Market 'representation'
c indicator. On return:
c
c coordinate (for sparse data)
c array (for dense data)
c elemental (to be added)
c
c field character*7 out Matrix Market 'field'. On return:
c
c real
c complex
c integer
c pattern
c
c symm character*19 out Matrix Market 'field'. On return:
c
c symmetric
c hermitian
c skew-symmetric
c general
c
c rows integer out Number of rows in matrix.
c
c cols integer out Number of columns in matrix.
c
c nnz integer out Number of nonzero entries required to
c store matrix.
c
c nnzmax integer in Maximum dimension of data arrays.
c
c indx integer(nnz)out Row indices for coordinate format.
c Undefined for array format.
c
c jndx integer(nnz)out Column indices for coordinate format.
c Undefined for array format.
c
c ival integer(nnz) out Integer data (if applicable, see 'field')
c
c rval double(nnz) out Real data (if applicable, see 'field')
c
c cval complex(nnz)out Complex data (if applicable, see 'field')
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Declarations:
c
integer ival(*)
double precision rval(*)
complex cval(*)
double precision rpart,ipart
integer indx(*)
integer jndx(*)
integer i, rows, cols, nnz, nnzreq, nnzmax, iunit
integer count
character mmhead*15
character mmtype*6
character rep*10
character field*7
character symm*19
character tmp1*1024
character tmp2*2
c
c Read header line and check validity:
c
read (iunit,end=1000,fmt=5) tmp1
5 format(1024A)
call getwd(mmhead,tmp1,1024,1,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(mmtype,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(rep,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(field,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(symm,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
if ( mmhead .ne. '%%MatrixMarket' ) go to 5000
c
c Convert type code to lower case for easier comparisons:
c
call lowerc(mmtype,1,6)
if ( mmtype .ne. 'matrix' ) then
print *,'Invalid matrix type: ',mmtype
print *,'This reader only understands type ''matrix''.'
stop
else
call lowerc(rep,1,10)
call lowerc(field,1,7)
call lowerc(symm,1,19)
endif
c
c Test input qualifiers:
c
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
* go to 6000
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' .and.
* field .ne. 'pattern') go to 7000
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' ) go to 8000
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
* go to 9000
c
c Read through comment lines, ignoring content:
c
read (iunit,end=2000,fmt=200) tmp2
200 format(1a)
10 continue
if ( tmp2(1:1) .ne. '%' ) then
go to 20
endif
read (iunit,end=2000,fmt=200) tmp2
go to 10
20 continue
c
c Just read a non-comment.
c Now, back up a line, and read for first int, and back up
c again. This will set pointer to just before apparent size
c info line.
c Before continuing with free form input, count the number of
c words on the size info line to ensure there is the right amount
c of info (2 words for array matrices, 3 for coordinate matrices).
c
backspace (iunit)
read (iunit,end=1000,fmt=5) tmp1
call countwd(tmp1,1024,1,count)
if ( rep .eq. 'array' .and. count .ne. 2 ) go to 3000
if ( rep .eq. 'coordinate' .and. count .ne. 3 ) go to 3500
c
c Correct number of words are present, now back up and read them.
c
backspace (iunit)
c
if ( rep .eq. 'coordinate' ) then
c
c Read matrix in sparse coordinate format
c
read (iunit,fmt=*) rows,cols,nnz
c
c Check to ensure adequate storage is available
c
if ( nnz .gt. nnzmax ) then
print *,'insufficent array lengths for matrix of ',nnz,
* ' nonzeros.'
print *,'resize nnzmax to at least ',nnz,'. (currently ',
* nnzmax,')'
stop
endif
c
c Read data according to data type (real,integer,complex, or pattern)
c
if ( field .eq. 'integer' ) then
do 30 i=1,nnz
read (iunit,fmt=*,end=4000) indx(i),jndx(i),ival(i)
30 continue
elseif ( field .eq. 'real' ) then
do 35 i=1,nnz
read (iunit,fmt=*,end=4000) indx(i),jndx(i),rval(i)
35 continue
elseif ( field .eq. 'complex' ) then
do 40 i=1,nnz
read (iunit,fmt=*,end=4000) indx(i),jndx(i),rpart,ipart
cval(i) = cmplx(rpart,ipart)
40 continue
elseif ( field .eq. 'pattern' ) then
do 50 i=1,nnz
read (iunit,fmt=*,end=4000) indx(i),jndx(i)
50 continue
else
print *,'''',field,''' data type not recognized.'
stop
endif
rewind(iunit)
return
c
elseif ( rep .eq. 'array' ) then
c
c Read matrix in dense column-oriented array format
c
read (iunit,fmt=*) rows,cols
c
c Check to ensure adequate storage is available
c
if ( symm .eq. 'symmetric' .or. symm .eq. 'hermitian' ) then
nnzreq = (rows*cols - rows)/2 + rows
nnz = nnzreq
elseif ( symm .eq. 'skew-symmetric' ) then
nnzreq = (rows*cols - rows)/2
nnz = nnzreq
else
nnzreq = rows*cols
nnz = nnzreq
endif
if ( nnzreq .gt. nnzmax ) then
print *,'insufficent array length for ',rows, ' by ',
* cols,' dense ',symm,' matrix.'
print *,'resize nnzmax to at least ',nnzreq,'. (currently ',
* nnzmax,')'
stop
endif
c
c Read data according to data type (real,integer,complex, or pattern)
c
if ( field .eq. 'integer' ) then
do 60 i=1,nnzreq
read (iunit,fmt=*,end=4000) ival(i)
60 continue
elseif ( field .eq. 'real' ) then
do 65 i=1,nnzreq
read (iunit,fmt=*,end=4000) rval(i)
65 continue
elseif ( field .eq. 'complex' ) then
do 70 i=1,nnzreq
read (iunit,fmt=*,end=4000) rpart,ipart
cval(i) = cmplx(rpart,ipart)
70 continue
else
print *,'''pattern'' data not consistant with type ''array'''
stop
endif
rewind(iunit)
return
else
print *,'''',rep,''' representation not recognized.'
print *, 'Recognized representations:'
print *, ' array'
print *, ' coordinate'
stop
endif
c
c Various error conditions:
c
1000 print *,'Premature end-of-file.'
print *,'No lines found.'
stop
2000 print *,'Premature end-of-file.'
print *,'No data lines found.'
stop
3000 print *,'Size info inconsistant with representation.'
print *,'Array matrices need exactly 2 size descriptors.'
print *, count,' were found.'
stop
3500 print *,'Size info inconsistant with representation.'
print *,'Coordinate matrices need exactly 3 size descriptors.'
print *, count,' were found.'
stop
4000 print *,'Premature end-of-file.'
print *,'Check that the data file contains ',nnz,
* ' lines of i,j,[val] data.'
print *,'(it appears there are only ',i,' such lines.)'
stop
5000 print *,'Invalid matrix header: ',tmp1
print *,'Correct header format:'
print *,'%%MatrixMarket type representation field symmetry'
print *
print *,'Check specification and try again.'
6000 print *,'''',rep,''' representation not recognized.'
print *, 'Recognized representations:'
print *, ' array'
print *, ' coordinate'
stop
7000 print *,'''',field,''' field is not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
print *, ' pattern'
stop
8000 print *,'''',field,''' arrays are not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
stop
9000 print *,'''',symm,''' symmetry is not recognized.'
print *, 'Recognized symmetries:'
print *, ' general'
print *, ' symmetric'
print *, ' hermitian'
print *, ' skew-symmetric'
stop
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c End of subroutine mmread
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine mminfo(iunit,rep,field,symm,rows,cols,nnz)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c This routine will read header information from a Matrix Market
c formatted file.
c
c The unit iunit must be open, and the file will be rewound on return.
c
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
c 18-Oct-96 Change in routine name to match C and Matlab routines.
c 30-Oct-96 Bug fixes in mmio.f:
c -looping for comment lines
c -fixed non-ansi zero stringlength
c -incorrect size calculation for skew-symmetric arrays
c Other changes in mmio.f:
c -added integer value parameter to calling sequences
c -enforced proper count in size info line
c -added routine to count words in string (countwd)
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
c of the initial version and suggested fixes.)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Arguments:
c
c name type in/out description
c ---------------------------------------------------------------
c
c iunit integer in Unit identifier for the open file
c containing the data to be read.
c
c rep character*10 out Matrix Market 'representation'
c indicator. On return:
c
c coordinate (for sparse data)
c array (for dense data)
c elemental (to be added)
c
c field character*7 out Matrix Market 'field'. On return:
c
c real
c complex
c integer
c pattern
c
c symm character*19 out Matrix Market 'field'. On return:
c
c symmetric
c hermitian
c skew-symmetric
c general
c
c rows integer out Number of rows in matrix.
c
c cols integer out Number of columns in matrix.
c
c nnz integer out Number of nonzero entries required to store
c the matrix.
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Declarations:
c
integer i, rows, cols, nnz, iunit
integer count
character mmhead*14
character mmtype*6
character rep*10
character field*7
character symm*19
character tmp1*1024
character tmp2*2
c
c Read header line and check validity:
c
read (iunit,end=1000,fmt=5) tmp1
5 format(1024A)
c
c Parse words from header line:
c
call getwd(mmhead,tmp1,1024,1,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(mmtype,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(rep,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(field,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
call getwd(symm,tmp1,1024,next,next,count)
if ( count .eq. 0 ) go to 5000
if ( mmhead .ne. '%%MatrixMarket' ) go to 5000
c
c Convert type code to upper case for easier comparisons:
c
call lowerc(mmtype,1,6)
if ( mmtype .ne. 'matrix' ) then
print *,'Invalid matrix type: ',mmtype
print *,'This reader only understands type ''matrix''.'
stop
else
call lowerc(rep,1,10)
call lowerc(field,1,7)
call lowerc(symm,1,19)
endif
c
c Test input qualifiers:
c
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
* go to 6000
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' .and.
* field .ne. 'pattern') go to 7000
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' ) go to 8000
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
* go to 9000
c
c Read through comment lines, ignoring content:
c
read (iunit,end=2000,fmt=200) tmp2
200 format(1a)
10 continue
if ( tmp2(1:1) .ne. '%' ) then
go to 20
endif
read (iunit,end=2000,fmt=200) tmp2
go to 10
20 continue
c
c Just read a non-comment.
c Now, back up a line, and read for first int, and back up
c again. This will set pointer to just before apparent size
c info line.
c Before continuing with free form input, count the number of
c words on the size info line to ensure there is the right amount
c of info (2 words for array matrices, 3 for coordinate matrices).
c
backspace (iunit)
read (iunit,end=1000,fmt=5) tmp1
call countwd(tmp1,1024,1,count)
if ( rep .eq. 'array' .and. count .ne. 2 ) go to 3000
if ( rep .eq. 'coordinate' .and. count .ne. 3 ) go to 3500
c
c Correct number of words are present, now back up and read them.
c
backspace (iunit)
c
if ( rep .eq. 'coordinate' ) then
c
c Read matrix in sparse coordinate format
c
read (iunit,fmt=*) rows,cols,nnz
c
c Rewind before returning
c
rewind(iunit)
return
c
elseif ( rep .eq. 'array' ) then
c
c Read matrix in dense column-oriented array format
c
read (iunit,fmt=*) rows,cols
if ( symm .eq. 'symmetric' .or. symm .eq. 'hermitian' ) then
nnz = (rows*cols - rows)/2 + rows
elseif ( symm .eq. 'skew-symmetric' ) then
nnz = (rows*cols - rows)/2
else
nnz = rows*cols
endif
c
c Rewind before returning
c
rewind(iunit)
return
else
print *,'''',rep,''' representation not recognized.'
print *, 'Recognized representations:'
print *, ' array'
print *, ' coordinate'
stop
endif
c
c Various error conditions:
c
1000 print *,'Premature end-of-file.'
print *,'No lines found.'
stop
2000 print *,'Premature end-of-file.'
print *,'No data found.'
stop
3000 print *,'Size info inconsistant with representation.'
print *,'Array matrices need exactly 2 size descriptors.'
print *, count,' were found.'
stop
3500 print *,'Size info inconsistant with representation.'
print *,'Coordinate matrices need exactly 3 size descriptors.'
print *, count,' were found.'
stop
5000 print *,'Invalid matrix header: ',tmp1
print *,'Correct header format:'
print *,'%%MatrixMarket type representation field symmetry'
print *
print *,'Check specification and try again.'
stop
6000 print *,'''',rep,''' representation not recognized.'
print *, 'Recognized representations:'
print *, ' array'
print *, ' coordinate'
stop
7000 print *,'''',field,''' field is not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
print *, ' pattern'
stop
8000 print *,'''',field,''' arrays are not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
stop
9000 print *,'''',symm,''' symmetry is not recognized.'
print *, 'Recognized symmetries:'
print *, ' general'
print *, ' symmetric'
print *, ' hermitian'
print *, ' skew-symmetric'
stop
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c End of subroutine mmread
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine mmwrite(ounit,rep,field,symm,rows,cols,nnz,
* indx,jndx,ival,rval,cval)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c This routine will write data to a matrix market formatted file.
c The data may be either sparse coordinate format, or dense array format.
c
c The unit ounit must be open.
c
c 20-Sept-96 Karin A. Remington, NIST ACMD (karin@cam.nist.gov)
c 18-Oct-96 Change in routine name to match C and Matlab routines.
c 30-Oct-96 Bug fixes in mmio.f:
c -looping for comment lines
c -fixed non-ansi zero stringlength
c -incorrect size calculation for skew-symmetric arrays
c Other changes in mmio.f:
c -added integer value parameter to calling sequences
c -enforced proper count in size info line
c -added routine to count words in string (countwd)
c (Thanks to G.P.Leendetse and H.Oudshoom for their review
c of the initial version and suggested fixes.)
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Arguments:
c
c name type in/out description
c ---------------------------------------------------------------
c
c ounit integer in Unit identifier for the file
c to which the data will be written.
c Must be open prior to call.
c
c rep character* in Matrix Market 'representation'
c indicator. Valid inputs:
c
c coordinate (for sparse data)
c array (for dense data)
c *elemental* (to be added)
c
c field character* in Matrix Market 'field'. Valid inputs:
c
c real
c complex
c integer
c pattern (not valid for dense arrays)
c
c symm character* in Matrix Market 'field'. Valid inputs:
c
c symmetric
c hermitian
c skew-symmetric
c general
c
c rows integer in Number of rows in matrix.
c
c cols integer in Number of columns in matrix.
c
c nnz integer in Number of nonzero entries in matrix.
c (rows*cols for array matrices)
c
c indx integer(nnz)in Row indices for coordinate format.
c Undefined for array format.
c
c jndx integer(nnz)in Column indices for coordinate format.
c Undefined for array format.
c
c ival integer(nnz) in Integer data (if applicable, see 'field')
c
c rval double(nnz) in Real data (if applicable, see 'field')
c
c cval complex(nnz)in Complex data (if applicable, see 'field')
c
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c Declarations:
c
integer ival(*)
double precision rval(*)
complex cval(*)
integer indx(*)
integer jndx(*)
integer i, rows, cols, nnz, nnzreq, ounit
character*(*)rep,field,symm
c
c Test input qualifiers:
c
if (rep .ne. 'coordinate' .and. rep .ne. 'array' )
* go to 1000
if (rep .eq. 'coordinate' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' .and.
* field .ne. 'pattern') go to 2000
if (rep .eq. 'array' .and. field .ne. 'integer' .and.
* field .ne. 'real' .and. field .ne. 'complex' ) go to 3000
if (symm .ne. 'general' .and. symm .ne. 'symmetric' .and.
* symm .ne. 'hermitian' .and. symm .ne. 'skew-symmetric')
* go to 4000
c
c Write header line:
c
write(unit=ounit,fmt=5)rep,' ',field,' ',symm
5 format('%%MatrixMarket matrix ',11A,1A,8A,1A,20A)
c
c Write size information:
c
if ( rep .eq. 'coordinate' ) then
nnzreq=nnz
write(unit=ounit,fmt=*) rows,cols,nnz
if ( field .eq. 'integer' ) then
do 10 i=1,nnzreq
write(unit=ounit,fmt=*)indx(i),jndx(i),ival(i)
10 continue
elseif ( field .eq. 'real' ) then
do 20 i=1,nnzreq
write(unit=ounit,fmt=*)indx(i),jndx(i),rval(i)
20 continue
elseif ( field .eq. 'complex' ) then
do 30 i=1,nnzreq
write(unit=ounit,fmt=*)indx(i),jndx(i),
* real(cval(i)),aimag(cval(i))
30 continue
else
c field .eq. 'pattern'
do 40 i=1,nnzreq
write(unit=ounit,fmt=*)indx(i),jndx(i)
40 continue
endif
else
c rep .eq. 'array'
if ( symm .eq. 'general' ) then
nnzreq = rows*cols
elseif ( symm .eq. 'symmetric' .or.
* symm .eq. 'hermitian' ) then
nnzreq = (rows*cols - rows)/2 + rows
else
c symm .eq. 'skew-symmetric'
nnzreq = (rows*cols - rows)/2
endif
write(unit=ounit,fmt=*)rows,cols
if ( field .eq. 'integer' ) then
do 50 i=1,nnzreq
write(unit=ounit,fmt=*)ival(i)
50 continue
elseif ( field .eq. 'real' ) then
do 60 i=1,nnzreq
write(unit=ounit,fmt=*)rval(i)
60 continue
else
c field .eq. 'complex'
do 70 i=1,nnzreq
write(unit=ounit,fmt=*)real(cval(i)),aimag(cval(i))
70 continue
endif
endif
return
c
c Various errors
c
1000 print *,'''',rep,''' representation not recognized.'
print *, 'Recognized representations:'
print *, ' array'
print *, ' coordinate'
stop
2000 print *,'''',field,''' field is not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
print *, ' pattern'
stop
3000 print *,'''',field,''' arrays are not recognized.'
print *, 'Recognized fields:'
print *, ' real'
print *, ' complex'
print *, ' integer'
stop
4000 print *,'''',symm,''' symmetry is not recognized.'
print *, 'Recognized symmetries:'
print *, ' general'
print *, ' symmetric'
print *, ' hermitian'
print *, ' skew-symmetric'
stop
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
end
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c End of subroutine mmwrite
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
subroutine lowerc(string,pos,len)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c Convert uppercase letters to lowercase letters in string with
c starting postion pos and length len.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
integer pos, len
character*(*) string
character*26 lcase, ucase
save lcase,ucase
data lcase/'abcdefghijklmnopqrstuvwxyz'/
data ucase/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
do 10 i=pos,len
k = index(ucase,string(i:i))
if (k.ne.0) string(i:i) = lcase(k:k)
10 continue
return
end
subroutine getwd(word,string,slen,start,next,wlen)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c Getwd extracts the first word from string starting
c at position start. On return, next is the position
c of the blank which terminates the word in string.
c If the found word is longer than the allocated space
c for the word in the calling program, the word will be
c truncated to fit.
c Count is set to the length of the word found.
c
c 30-Oct-96 Bug fix: fixed non-ansi zero stringlength
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
integer slen, start, next, begin, space, wlen
character*(*) word
character*(*) string
begin = start
do 5 i=start,slen
space = index(string(i:slen),' ')
if ( space .gt. 1) then
next = i+space-1
go to 100
endif
begin=begin+1
5 continue
100 continue
wlen=next-begin
if ( wlen .le. 0 ) then
wlen = 0
word = ' '
return
endif
word=string(begin:begin+wlen)
return
end
subroutine countwd(string,slen,start,count)
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c Countwd counts the number of words in string starting
c at position start. On return, count is the number of words.
c 30-Oct-96 Routine added
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
character*(*) string
integer slen, start, next, wordlength, count
character tmp2*2
count = 0
next = 1
10 call getwd(tmp2,string,1024,next,next,wordlength)
if ( wordlength .gt. 0 ) then
count = count + 1
go to 10
endif
return
end
arpack-ng-3.1.5/TESTS/dnsimp.f 0000644 0001750 0001750 00000050462 12277373057 012673 0000000 0000000 program dnsimp
c
c
c This example program is intended to illustrate the
c simplest case of using ARPACK in considerable detail.
c This code may be used to understand basic usage of ARPACK
c and as a template for creating an interface to ARPACK.
c
c This code shows how to use ARPACK to find a few eigenvalues
c (lambda) and corresponding eigenvectors (x) for the standard
c eigenvalue problem:
c
c A*x = lambda*x
c
c where A is a n by n real nonsymmetric matrix.
c
c The main points illustrated here are
c
c 1) How to declare sufficient memory to find NEV
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 DNAUPD
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 DNEUPD.
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
c appropriately, to specify WHICH eigenvalues you want to compute
c and to supply a matrix-vector product
c
c w <- Av
c
c in place of the call to AV( ) below.
c
c Once usage of this routine is understood, you may wish to explore
c the other available options to improve convergence, to solve generalized
c problems, etc. Look at the file ex-nonsym.doc in DOCUMENTS directory.
c This codes implements
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (nx,x,y)" computes y = A*x
c ... Use mode 1 of DNAUPD.
c
c\BeginLib
c
c\Routines called:
c dnaupd ARPACK reverse communication interface routine.
c dneupd ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: nsimp.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
c %------------------------------------------------------%
c | Storage Declarations: |
c | |
c | The maximum dimensions for all arrays are |
c | set here to accommodate a problem size of |
c | N .le. MAXN |
c | |
c | NEV is the number of eigenvalues requested. |
c | See specifications for ARPACK usage below. |
c | |
c | NCV is the largest number of basis vectors that will |
c | be used in the Implicitly Restarted Arnoldi |
c | Process. Work per major iteration is |
c | proportional to N*NCV*NCV. |
c | |
c | You must set: |
c | |
c | MAXN: Maximum dimension of the A allowed. |
c | MAXNEV: Maximum NEV allowed. |
c | MAXNCV: Maximum NCV allowed. |
c %------------------------------------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=2500, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), d(maxncv,3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, ierr,
& j, ishfts, maxitr, mode1, nconv
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2, daxpy
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c Storage and variables for getting matrix from disk
c
integer dimA, sizeA
parameter (dimA = 50)
parameter (sizeA = dimA*dimA)
character rep*10
character field*7
character symm*19
double precision A(sizeA)
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------------------------%
c | The following include statement and assignments |
c | initiate trace output from the internal |
c | actions of ARPACK. See debug.doc in the |
c | DOCUMENTS directory for usage. Initially, the |
c | most useful information will be a breakdown of |
c | time spent in the various stages of computation |
c | given by setting mnaupd = 1. |
c %-------------------------------------------------%
c
include 'debug.h'
ndigit = -3
logfil = 6
mnaitr = 0
mnapps = 0
mnaupd = 1
mnaup2 = 0
mneigh = 0
mneupd = 0
c
c Read in A matrix from disk, Matrix Market format
c
open(10, FILE='testA.mtx',STATUS='OLD')
call mmread(10,rep,field,symm,nrows,ncols,nnz,sizeA,
* temp,temp,temp,A,temp)
close(10)
c
c %-------------------------------------------------%
c | The following sets dimensions for this problem. |
c %-------------------------------------------------%
c
nx = dimA
n = nx*nx
c
c %-----------------------------------------------%
c | |
c | Specifications for ARPACK usage are set |
c | below: |
c | |
c | 1) NEV = 4 asks for 4 eigenvalues to be |
c | computed. |
c | |
c | 2) NCV = 20 sets the length of the Arnoldi |
c | factorization. |
c | |
c | 3) This is a standard problem. |
c | (indicated by bmat = 'I') |
c | |
c | 4) Ask for the NEV eigenvalues of |
c | largest magnitude. |
c | (indicated by which = 'LM') |
c | See documentation in DNAUPD for the |
c | other options SM, LR, SR, LI, SI. |
c | |
c | Note: NEV and NCV must satisfy the following |
c | conditions: |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c | |
c %-----------------------------------------------%
c
nev = 10
ncv = 20
bmat = 'I'
which = 'SR'
c
if ( n .gt. maxn ) then
print *, ' ERROR with _NSIMP: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NSIMP: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NSIMP: NCV is greater than MAXNCV '
go to 9000
end if
c
c %-----------------------------------------------------%
c | |
c | Specification of stopping rules and initial |
c | conditions before calling DNAUPD |
c | |
c | TOL determines the stopping criterion. |
c | |
c | Expect |
c | abs(lambdaC - lambdaT) < TOL*abs(lambdaC) |
c | computed true |
c | |
c | If TOL .le. 0, then TOL <- macheps |
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 DNAUPD. (see usage below) |
c | |
c | It MUST initially be set to 0 before the first |
c | call to DNAUPD. |
c | |
c | INFO on entry specifies starting vector information |
c | and on return indicates error codes |
c | |
c | Initially, setting INFO=0 indicates that a |
c | random starting vector is requested to |
c | start the ARNOLDI iteration. Setting INFO to |
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 DNAUPD as |
c | workspace. Its dimension LWORKL is set as |
c | illustrated below. |
c | |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
c %---------------------------------------------------%
c | Specification of Algorithm Mode: |
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 DNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 30
mode1 = 1
c
iparam(1) = ishfts
c
iparam(3) = maxitr
c
iparam(7) = mode1
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call dnaupd ( ido, bmat, n, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- Op*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av (nx, A, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
endif
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in DNAUPD. |
c %--------------------------%
c
print *, ' '
print *, ' Error with _naupd, info = ',info
print *, ' Check the documentation of _naupd'
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
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 DNEUPD now called to do this |
c | post processing (Other modes may require |
c | more complicated post processing than |
c | mode1,) |
c | |
c %-------------------------------------------%
c
c change to .true. to invoke bug with latest ARPACK
rvec = .true.
c
call dneupd ( rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, n, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %------------------------------------------------%
c | The real parts of the eigenvalues are returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part are returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first |
c | NCONV (= IPARAM(5)) columns of the two |
c | dimensional array V if requested. Otherwise, |
c | an orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %------------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (IPARAM(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(nx, A, v(1,j), ax)
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
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(nx, A, v(1,j), ax)
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 av(nx, A, v(1,j+1), ax)
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
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call dmout(6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real, Imag) and residual residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _NSIMP '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dnsimp. |
c %---------------------------%
c
9000 continue
c
end
c
c==========================================================================
c
c matrix vector subroutine for Matrix Market format
c
subroutine av (nx, A, v, w)
integer nx
double precision A(nx*nx)
double precision v(nx)
double precision w(nx)
CALL DGEMV('N', nx, nx, 1.D0, A, nx, v, 1, 0.D0, w, 1)
return
end
c==========================================================================
arpack-ng-3.1.5/TESTS/testA.mtx 0000644 0001750 0001750 00000141613 12277373057 013043 0000000 0000000 %%MatrixMarket matrix array real general
50 50
0.785477746971993
0.3487979039537641
0.7805146932399352
0.04639733830233506
0.3528326397346507
0.3569978249760635
0.1297350384361505
0.982246278024004
0.4157538437690493
0.4064852658401442
0.7826907311910321
0.4332040762007042
0.5762781335843088
0.6504683320851675
0.03301078951995928
0.4040116867030087
0.9589442371049525
0.5955197892084537
0.9330784472068183
0.9370408018054169
0.755739132102865
0.5389141853960157
0.824291331591074
0.01074684679419458
0.7465189612792997
0.1030347714755694
0.04841078390624876
0.1856911188169322
0.4728397095943639
0.009635624129514575
0.8581804875041081
0.473489526284177
0.1499347502480597
0.2454546456338438
0.05679114347296121
0.2052447977600489
0.4654891391892809
0.4609751781726875
0.3510560745857403
0.4410027719238406
0.3294070340782147
0.5720972666632248
0.9923532942572489
0.7178508247258696
0.3609955494943963
0.5727285310866952
0.380334616231601
0.3720832659542683
0.4242746440792126
0.743126890424134
0.3600804859802486
0.6264892525998698
0.8528696979940593
0.1200247511554488
0.1743426610234867
0.9506277973948728
0.9775014744646178
0.2520048750200072
0.2846204663380523
0.8382863222371713
0.8021007406466505
0.3699613252736327
0.3628109808983833
0.2717412803686399
0.2594693068200173
0.9943943764782905
0.04626332151900758
0.676333122761173
0.5016846476944681
0.1132880045247155
0.4613146610087643
0.7186305087313831
0.9606028069740032
0.5289001071687568
0.9354166990072734
0.9895869467181484
0.4657158742572806
0.3637964635117122
0.09033585803973088
0.8442037577127756
0.4137060639805334
0.7573584463229948
0.5540333917187943
0.4762402695189945
0.2665904634759624
0.1352774730481348
0.07770078242238931
0.8465934481018298
0.3370429676745105
0.6739938085623638
0.1044327527205435
0.5873658711723124
0.1148029215972856
0.2493453471253348
0.4141727194827263
0.7154667410554738
0.8696705805132049
0.8154279047505926
0.2324492267049706
0.3463352321030684
0.9606123640046534
0.3013127998659693
0.1541962714040133
0.7444364889732262
0.2828948192134233
0.3288394341063856
0.001331899324266028
0.5639135027069234
0.4441336664723178
0.1613629726756592
0.7034620730766737
0.5440310820917447
0.2546197210438877
0.3931108463236969
0.2446190883516498
0.5826889888498005
0.05274347285318848
0.6022926746467665
0.0399708089586055
0.862410181147088
0.3431098612841256
0.1122334668530195
0.5934265793357891
0.6300767436263487
0.7813804286218665
0.7365141289656262
0.7915971495933176
0.6487113375906534
0.9119083204186691
0.6060760940514087
0.7364455923975894
0.7132515252496476
0.6899871935121503
0.9198698714047484
0.9695459326452706
0.3289260712211756
0.0948157350606309
0.8065327242904161
0.6827348018214118
0.1732469749466258
0.4810099479577276
0.9393384962081817
0.1380723531464624
0.6596539707125604
0.1940392541687596
0.6264839774084364
0.6207350667460493
0.4409771822906031
0.6589473334358749
0.4471522149209517
0.8516043990050657
0.707325167402407
0.4285460912391532
0.6201970073796529
0.6411923102764684
0.8877501139999284
0.9936044688755724
0.7283538029708085
0.5058227768020763
0.0489289775130024
0.1082186368203727
0.8582963161297583
0.9159444859281713
0.6716598429495227
0.4623355728229777
0.9613897294569326
0.07991724267693834
0.3859134783732187
0.01643621003588813
0.5919071499917847
0.5682363063277869
0.01227069059721619
0.5898053099467179
0.3602165318875826
0.02543467078473394
0.978579761238208
0.132194080589215
0.5505765649427828
0.8634380874579264
0.6825406888197932
0.0349691968296445
0.4401978761541638
0.4398271265785039
0.7661117216746011
0.9998392859913364
0.2574659883339916
0.8858143208637792
0.04972157103389974
0.3316557703098792
0.7295536846326214
0.4987017737789714
0.5466595947977323
0.2246393613355143
0.1229806664092477
0.4852119902536941
0.8740422916897428
0.6414252507013896
0.448237264729561
0.1371437537469765
0.1411592626473303
0.9825957877078813
0.9718842592801087
0.4288925475331414
0.7560385100620807
0.5585906494926747
0.7566543940548329
0.9759200931130441
0.04187404891074498
0.3510034994566942
0.4766479626746113
0.1749353313910484
0.3559045434280724
0.8884694667358662
0.06915304918996579
0.09274743433829613
0.2058041811695166
0.6151989797735369
0.2734320505178574
0.7477853723015149
0.3057263303160654
0.7654443608285397
0.2528857313814297
0.6710159754058498
0.1319141076851283
0.9424483975171577
0.4445831830037891
0.3579953389560695
0.1698009580462535
0.4990740652970074
0.4521662003789466
0.06621598018508956
0.8878816746402023
0.9077841259013457
0.7826543285090828
0.4719435592128948
0.7961423037509666
0.8756473884552697
0.672251562170698
0.07038273569249898
0.1244719051636705
0.4253661833493746
0.7826657687271615
0.5891465452181943
0.472135906386569
0.03378847131208373
0.1800735356257248
0.9318196587890124
0.5907640092022789
0.5063355074004539
0.2184388567089357
0.9520510359400713
0.3622595138670178
0.4585467547031696
0.8308101379815688
0.7906650292938511
0.4410227332764227
0.624033793781809
0.9555082563177895
0.6634786584691315
0.2664909433643546
0.7231548402151613
0.5610778863444552
0.9729806673535957
0.300872644671042
0.4970204982873512
0.2839541084180133
0.07420800479069112
0.1113971873584092
0.07530693597058391
0.9961920276056592
0.5995976799427042
0.7889680133824533
0.8612686396119258
0.8270682662827376
0.9369237319378176
0.03585346059872863
0.1397107868285771
0.7254420808741763
0.8720941690444312
0.3741032715271484
0.2161875172375887
0.5760100991729804
0.02564675507870395
0.04350492459943456
0.9334492840456863
0.4016519282670342
0.784920768198348
0.2426285683246231
0.6085427249614176
0.8931839095044156
0.6294198612749861
0.9241468713515014
0.9958045717010496
0.1500898727081097
0.0247968997642114
0.9112640978694548
0.1479974584762698
0.08994305728914831
0.7156935991512468
0.1750144087214003
0.1597215901765089
0.4789321438336922
0.9487316515929421
0.7410701414583998
0.6723334621307215
0.07034524776921214
0.306105485335777
0.9368330555162471
0.8569370036714432
0.8908473807371433
0.5885869188376135
0.1625863275472845
0.1760451198070986
0.7475636146656869
0.9452858159764821
0.6579797890025046
0.5438319769493755
0.597653088285055
0.2346028920083675
0.8197677313852929
0.7884955332886817
0.5890596131763408
0.4362597781734968
0.5497394277698254
0.3529687059355037
0.9957911935288701
0.3649636000157559
0.9661744915175106
0.02474087295271821
0.7778391141332808
0.4401821193514919
0.6304999283010138
0.3140246962027101
0.9218152845077431
0.223324620519386
0.3744862718582102
0.308144382373381
0.03782247412293893
0.6051696745116568
0.8358643693596579
0.5882522328135681
0.363454795408988
0.1398851836195577
0.1165337215374741
0.9812174340694373
0.5416923490303707
0.08650990843852258
0.2560962277889639
0.2097750108362821
0.3146098036047049
0.9037515961022937
0.5206963071271951
0.1622360100122205
0.1436122075132696
0.06405307547809114
0.8546454586236044
0.9744567855933727
0.9290251035545817
0.4095202212744194
0.9016112200348491
0.4844972287823052
0.4696738402373906
0.16782819888636
0.08285847310239902
0.6331612550340965
0.3109789174444536
0.4663540347492581
0.2110694218127157
0.001445719644096899
0.7976112650229291
0.3680474260891505
0.01513757221000533
0.7149784664701372
0.218578762078392
0.6887172696251754
0.2460072212663873
0.2660848545886749
0.1320708237743482
0.3442103354331494
0.7543899837884479
0.8892386466346281
0.7104363766478412
0.2464750252404844
0.4513893484950648
0.9312242742848866
0.6156675802016933
0.2582899804934546
0.6311031740572448
0.6955321941690735
0.4036598780917015
0.1934818574131165
0.3070742247131825
0.6929545133882753
0.6303595654762358
0.2498239888406637
0.04342201773359355
0.5314514536148198
0.1762014479785938
0.5219020374730456
0.8712821356928252
0.6136128260846534
0.2714321214666282
0.8545396102204977
0.1574601396059017
0.2594186381299859
0.6705804806129237
0.225957392866863
0.8259665295501577
0.3240962823153496
0.4883865758261062
0.7637237533691866
0.7376755023326541
0.6360259462174113
0.2491409391354251
0.7343168277838188
0.3395051379245024
0.3027678383901801
0.1271419889831177
0.01014029872618327
0.9249287770547149
0.9100061956265441
0.3821479122189088
0.7013920658879069
0.6723419290946082
0.1276741301581854
0.2009690385939634
0.9028265435534628
0.8918363082972592
0.3776817348669247
0.250192901317445
0.6027014802313547
0.6254505454639542
0.01968288947887475
0.8197326024040279
0.5179445713187589
0.9094342441696686
0.1186249673851458
0.9461490412560633
0.9270448177172086
0.09480501121335916
0.4152573891451097
0.3228623167468689
0.8462535593737357
0.9479503196026123
0.7292205774342252
0.6838497247755004
0.6414119056438392
0.3158826005595834
0.7321467734818983
0.1576484094919425
0.7600706912283368
0.09190990317307413
0.9676539919570304
0.6089663483464548
0.8949524402754174
0.1941465307230787
0.9880579420484011
0.2413148615739501
0.2234209557685551
0.4019979417847204
0.780906365500356
0.8392120129369099
0.4094997745571338
0.4024005325797515
0.771750033223037
0.2491246863127975
0.8657410646456459
0.6821860668106868
0.9773929804085599
0.1855239055439958
0.2161827605131378
0.3129218581934915
0.7520120377257302
0.3677366068602035
0.6044560035391421
0.3834348914075437
0.5504878292599618
0.3854424217148836
0.665435033273495
0.01471416354633903
0.8131244687598854
0.3498559748292035
0.7155155252648524
0.9588938038786191
0.5074171207182671
0.6661682202678878
0.4294654343621953
0.8494985435682431
0.6542333772844336
0.5042577475921929
0.3685160595307131
0.6852494290194094
0.09920751517575654
0.04764683696675343
0.8693359149773495
0.651867365863888
0.6104587012058849
0.421945705248746
0.503707374957771
0.1641409233757976
0.0931721295240463
0.6853248645219484
0.1426712980869073
0.5287116532690262
0.003572773324275413
0.4250577909349806
0.2243409051764098
0.6599421323134866
0.5031018963796706
0.6000572398078374
0.200173658860432
0.137401018724244
0.02378902863438437
0.9395426982208841
0.695501323790041
0.5542331830091526
0.2954142891190643
0.0426317475056841
0.853760208334462
0.5966821008414195
0.01852677964293725
0.9331909618714797
0.009788324266871928
0.6409555396281559
0.7886853835491522
0.5265029442310405
0.291248417281234
0.6283285408839556
0.4254686715517636
0.5463703632725464
0.1907970833186644
0.7444888370095262
0.2128562192781711
0.1001224558771958
0.8963849862975128
0.822336975387737
0.8827837500502087
0.08812429541216493
0.7001876477408906
0.1702242237298729
0.8330442710530499
0.7280570847217779
0.7758930151359777
0.7634952514491528
0.05709946557471979
0.6098477216188559
0.8984718004483838
0.5161307245092146
0.5061715380674194
0.2556165564106579
0.9716031349585357
0.5811239224507527
0.9683864143366568
0.0414383729208978
0.1886282293621531
0.5197600590680359
0.6408539196628478
0.3407313225253646
0.6483298192076838
0.3554379655462507
0.8504300240413766
0.5428046812412212
0.6730800874607602
0.2565725793133774
0.1213382767079354
0.04060644586034068
0.8879431330894764
0.7531873158317328
0.8020791850262654
0.441405626647267
0.07517258571622043
0.1542296972876935
0.2472441483940219
0.0792259868541022
0.8531595631341649
0.1571768552907903
0.616662683688958
0.5284499444589416
0.1912198233556319
0.7597507602273893
0.6149984254928762
0.1520636067770824
0.4546374468581563
0.6820975998089609
0.2812591215759094
0.6248631208145372
0.9417301226014179
0.5668033360474686
0.6931155991051783
0.9785864110343221
0.8991173786750881
0.6484798960153297
0.9829208149449612
0.1638149681798106
0.5097868572275749
0.6273484296561036
0.8000009063332891
0.417769086107256
0.05483443189378079
0.5191441936509564
0.1345321356883087
0.3669744346450395
0.6966208874034296
0.129583524717075
0.7858495299874493
0.05030897359635167
0.8156155197006915
0.8669388624593534
0.1968964536536247
0.6073938011267771
0.9966797518862025
0.04237432746008252
0.1388230031294067
0.2229539740912246
0.5830104779642798
0.6711064868556157
0.7231959851182224
0.5044385129861295
0.6446302628311489
0.03636934067604214
0.1938518253349607
0.7495457121028239
0.3081783758448918
0.7490521518246954
0.85203732135201
0.09935547638279607
0.597778198787964
0.7206022557643235
0.5687138321154716
0.2351100910853098
0.910636226408683
0.9506197570954015
0.5163152948198082
0.7070881302571722
0.7987951929403031
0.1996893666527755
0.1068405154497045
0.6185748433158113
0.02222394078230217
0.03756204368831895
0.1153641215880208
0.8186972404462725
0.3768992258031192
0.2291563121361598
0.3681399130368996
0.1745404238713363
0.7747796388327376
0.330030614354014
0.3157801399284597
0.7245869006264816
0.5849549834420218
0.7777555242671685
0.3595763876506322
0.1847330019164792
0.5736891081286625
0.4830945845647806
0.4216269404540742
0.3173251923814021
0.9725715071931813
0.2582226408369922
0.5670998996464329
0.3520669047409829
0.312029608919655
0.009397602757391432
0.668127492035812
0.8856876804971914
0.4213177264716675
0.8585800527346572
0.9479924916927481
0.3761067747970577
0.2032932484898388
0.1791694952414008
0.3062940833412099
0.8503119356661379
0.5256025310447409
0.828442251880212
0.1068764588739141
0.6171420317004981
0.5668265185664312
0.2609361569069434
0.002308110432938437
0.2872550628798151
0.8212700824567727
0.8951154046804658
0.9958079096062296
0.008438401807033813
0.732843238440102
0.08461726794253233
0.633348568099204
0.80508642560858
0.8299648864350688
0.5672214497239391
0.2600433904930519
0.7845320494016645
0.1692053340210961
0.2742583451752331
0.004903194288562784
0.3975612405280391
0.02655155323080127
0.8546990498098754
0.2048916891633613
0.8603505810976838
0.05612470880554887
0.2235117723663907
0.04528051780839293
0.7509917731126146
0.6980563799302092
0.9187878891211375
0.9089226043321582
0.8055238565445589
0.9996774453746491
0.8007662757545447
0.3229153326441299
0.02514458414445353
0.7328234712837909
0.4727867045481889
0.3925884021650015
0.8600140278133452
0.05746164912061491
0.384545138525541
0.1418404203668561
0.04568139777501767
0.6979947329621027
0.9135115020681923
0.3835456322906093
0.2431108172993578
0.9070977326477642
0.7020179128680837
0.8956378868936629
0.9479735592426914
0.9366919584324206
0.9967866310119839
0.3969424719019249
0.6599364493759738
0.8229502979494715
0.6223667300062823
0.7005063181449608
0.4895151047139465
0.5088168012407174
0.7797132955598631
0.04048577616286009
0.9010074025661139
0.7320457211210215
0.6157830684792364
0.7551880444699675
0.2844671855941731
0.2062491145769358
0.6521862129091853
0.9281199379807344
0.8045735148499104
0.3504360631022279
0.2701884059955971
0.7446177131237434
0.72299211004354
0.856720355874117
0.9188193236436777
0.2690083691650179
0.6881517793620033
0.6179970516901144
0.07155347293942749
0.1883982349888309
0.3355694688608594
0.3110458209591368
0.4202040179605758
0.0877387990616133
0.5598684829070103
0.6676252498623747
0.1153017136391573
0.3156603891989895
0.9807963423973177
0.8858695377113054
0.02275832942749123
0.8632855052413426
0.2449936208834124
0.4336017292379604
0.1353762016633067
0.2155999982318065
0.7747289151080012
0.0871862609352515
0.4003778253303322
0.5901109675535792
0.1965235690729467
0.6968124642448635
0.5929693149266995
0.4641899757262669
0.2411549478594502
0.4127704545038754
0.770494470747454
0.03533889164463344
0.6075502991334615
0.07947364889801101
0.4153764550439991
0.9854775762096046
0.8426484352769673
0.05240260210805847
0.7275179108311104
0.1149580297455479
0.4853809615892408
0.8685943678229374
0.01670387911369708
0.8189083780376529
0.7838736724098379
0.1937077328774883
0.9128442913151924
0.6836899416610769
0.8883935085276821
0.7128697043986415
0.4848920215417473
0.8332180426601535
0.09074642077306749
0.02549175650536506
0.335727870856154
0.4869226263333755
0.2253628272943481
0.5547087994895158
0.6811483927579534
0.8349432084199989
0.8958728132229383
0.4375979183285483
0.3996552888503655
0.4401199541345421
0.309626357593902
0.4469533720366108
0.9643901232477963
0.4623482323420648
0.4959920123859639
0.02153989279020663
0.1922851314665226
0.8981342605295961
0.3892922234206508
0.1020461540761098
0.3496985816779994
0.178546091108624
0.2490910623761474
0.6409844498846424
0.9757541601664016
0.9206638516873854
0.05380692850017921
0.9030846790110441
0.189999378694629
0.9926151977241786
0.3264995955911637
0.2275434957740902
0.943710729255865
0.8108468741367665
0.9244441600094481
0.718502000394367
0.8792565612572231
0.8650617674700564
0.3574250884479105
0.1362764683506361
0.8057804093275702
0.6811248466872695
0.4313871163731831
0.9471154190194666
0.9511727369975825
0.03208060731819962
0.2761667599324792
0.06775301313280913
0.8269493017238748
0.3963234452332561
0.5811767116122842
0.3435337799921883
0.9712097435824162
0.6034058056474978
0.6676411499628827
0.8633251611483932
0.4200870484241666
0.07341100220830876
0.8713970581693321
0.6946542435009362
0.8414246894261694
0.6762458345921877
0.7014017087337732
0.8954172171920597
0.5874139298251868
0.3251953625892174
0.9948506456792521
0.2075384266377166
0.286252616218108
0.8331083386053986
0.7702477474361495
0.2005791077201452
0.7647662965714126
0.6159233927148443
0.9642674159837193
0.503691258942202
0.4787018227879879
0.585696853852641
0.9795917261330512
0.3490990886704107
0.2610027568737846
0.5899424153658227
0.745384843673345
0.08198390427228663
0.3749558388033744
0.08700844434196431
0.3181514054810053
0.4532299455774073
0.1610809052464525
0.05986814869606805
0.4448652178130936
0.2852737675649195
0.1991782232491761
0.5098118955233614
0.01947843300731467
0.8301025950875111
0.2003855631700716
0.4265632262848765
0.7330884934167657
0.526796772931903
0.2692985112669554
0.7678352277503803
0.9544124738411768
0.117687371272035
0.02488822009103842
0.4220401145551942
0.06438396044610384
0.1256026558549721
0.09241775384059359
0.2326892734806901
0.2111930611634079
0.6098109805009314
0.3945270527075339
0.7266983918859443
0.9612981538496442
0.7502172043406883
0.07873977287961509
0.8679530511180489
0.3627708638712371
0.7970071271924942
0.7863871879017024
0.3313547476001703
0.9499914553181076
0.8284896434884577
0.6291297470050068
0.2956236319300697
0.6170045241840419
0.9885034306411764
0.3440088920612865
0.2396446662476179
0.0003971059067402471
0.9092898522997359
0.6275404572535281
0.7862292982802862
0.7487163360037624
0.6168976342636073
0.1834015811969786
0.8435932470703686
0.7159929394496765
0.6518013355770008
0.6128070715928453
0.8737861372262379
0.7926772718219981
0.7244249759676695
0.4091544292629353
0.9976534022974836
0.6238085036155495
0.3531652535856838
0.1827231412043262
0.3209043513382621
0.2556067664510513
0.9410847472911361
0.8929066755602225
0.9880521079603376
0.9524719750638411
0.8742069176380901
0.1622435007327453
0.146688413160472
0.6498031003682845
0.7900859411420516
0.07230160920739637
0.2445194403682387
0.01070715205155892
0.232541408581099
0.2548548790028199
0.9121879618595873
0.367546572759846
0.0380340235252129
0.6508323165877404
0.8163668635963278
0.08375040803342759
0.01148104737944577
0.3656153223198011
0.4127654421939717
0.4160209899580742
0.4633760149747584
0.4660065125496495
0.5481585323512327
0.5326909217871023
0.5076925540742117
0.7810913280219699
0.2899651479814135
0.5505018812451309
0.5746653306234409
0.2038915081095624
0.5552369724125421
0.2141160238951959
0.5491567220385508
0.06976982991884895
0.8604475144821226
0.2083827073215646
0.238632095670492
0.3805852152786106
0.2873663917866944
0.7505231294217088
0.3189389712503545
0.1073696753369522
0.8061358683365647
0.2520584544709007
0.5039048520554241
0.03985083879109019
0.6241937542114872
0.3874416076885199
0.3082738496857479
0.3320499623809993
0.9315932463763674
0.4679895603100958
7.099319345438282e-05
0.725780504048086
0.3994829192730686
0.02292363397336383
0.6377423890706582
0.439352012713857
0.5917691363808901
0.6179846103570156
0.4540966724851869
0.04908527589659761
0.7196941727447486
0.7400928623847778
0.4047987945955767
0.05141252539400964
0.948004653343517
0.8773868502354092
0.8276499476889687
0.448636593326791
0.8844747141946155
0.8537183373590775
0.6477367441150418
0.5067832670556288
0.07602290854549865
0.3624068845001056
0.2310911558051516
0.8601805037239481
0.6343900558370829
0.7314571147776474
0.1563552833732814
0.9496469379126524
0.4004229537728619
0.6113866753517463
0.7984892328696712
0.6863698195202363
4.834455750957201e-05
0.502657654353642
0.9856199957539303
0.007003720947192149
0.04092932437737173
0.1034229113351951
0.6034065583567469
0.04619028632623601
0.4218719448215087
0.3558631032453929
0.6976704570571679
0.3629777257146221
0.3245550476300417
0.6774757431538212
0.5832523698543565
0.2404547972654699
0.3748665663321581
0.2047346127014699
0.2586420846776649
0.8473144924919164
0.4270409423799212
0.6569829630057124
0.5312717480393021
0.9370190407450271
0.3334224200940459
0.3609118322538046
0.746493540455523
0.8639294687684046
0.02205376993444275
0.8495239270972266
0.8076254271844439
0.5427829454587535
0.4337830747302812
0.6024369191190526
0.3351052030338844
0.7781072047494094
0.0967197534128158
0.451954974000803
0.7619490654278906
0.6258332332285546
0.001491523255652272
0.01717240515075213
0.4568540721689267
0.2215640563953248
0.3714206858025393
0.4412321642580441
0.06068954702100038
0.3640423741371652
0.3768690740109791
0.301240237258343
0.9183891801482551
0.4773506757715675
0.1803924380296581
0.2970376394627258
0.8292994736543202
0.6181239929042461
0.6635995415112846
0.6162034118163047
0.2612667243781196
0.8724987166501006
0.005368127403688749
0.3652552918622246
0.5919718384003337
0.9248390593218262
0.4580048975877193
0.4242082242977333
0.6549616120639719
0.7642363084139678
0.3796435664138894
0.4540689670682517
0.6438020122938055
0.7351545263380519
0.633821562872391
0.782944271864228
0.03448701932094589
0.1008623391586755
0.04174077875812854
0.160518423407093
0.8350029471009827
0.5594340824616484
0.1720216998258309
0.9387990091180241
0.542159328902428
0.8302578561362792
0.3174437703332581
0.2327393564501141
0.7019938124953298
0.5197836480594014
0.2861462915821057
0.0276729267053365
0.1528029022659121
0.7839226097109037
0.5187518897952131
0.416822862672221
0.1085475569845107
0.6314276750904005
0.126733568056866
0.5806436635133652
0.1845003755459412
0.4949110902032333
0.3354406183161724
0.2068487698258999
0.105165521104586
0.1536325179688556
0.8733295499475763
0.7243714983347331
0.003584176016125706
0.8104152380120612
0.245622407967823
0.885936548815393
0.8392806494752019
0.3555673851890813
0.315247116832202
0.1541863083391155
0.3884232296043179
0.3054398481989467
0.82117581307302
0.279882346584207
0.8514539477602941
0.1952851559644642
0.3550024667941819
0.3459755810988887
0.585631351305979
0.4562507954067759
0.03844871163837227
0.3800155943468968
0.5464870450062875
0.06825806662535239
0.2132264650053793
0.7718975671071883
0.6303793693353407
0.808721360720695
0.02149000823209823
0.01175688788807794
0.3987966651926876
0.2096956748344578
0.5879147401777179
0.8227218950863271
0.7490759823584625
0.929144914732334
0.5245455343216855
0.5386454166341963
0.6672944993806594
0.8712611967415711
0.1813249291815934
0.699106624590959
0.1889102032619238
0.1998162124246845
0.7709659491067911
0.5298961882052664
0.004714637195271765
0.9553610500720577
0.8772790004858393
0.8723088963835226
0.4940252349035892
0.5311016926928747
0.0322607179908051
0.7501567083195859
0.7583520129192493
0.5835627390061723
0.3701170082661117
0.4919999375109856
0.5271824580938407
0.4487244653756858
0.1424009051482739
0.6527437323294034
0.6746702883821366
0.7497627748917182
0.3059258561245995
0.8043475921286082
0.2999667985320552
0.2740866750323177
0.2704849820626636
0.7634909292790785
0.3185752154417696
0.3570044482734788
0.675481877125386
0.03353822505807458
0.1500225440578283
0.4215501220956385
0.2128941447897994
0.7600721245385718
0.6433061365554781
0.8396467139452928
0.2077957647723677
0.4383475927277096
0.7321197516417176
0.1047517185833388
0.4445647141573581
0.490552705674478
0.6944263532843418
0.9308079854818532
0.1551507753707975
0.05268122066816694
0.6086764530409728
0.2429407845481393
0.5583021964316072
0.6785006744322112
0.4665047685235638
0.658405065829952
0.8083493389239484
0.8564392355170491
0.7108779140245594
0.2633336157624828
0.2961072401244553
0.1858452494209637
0.5993767065699106
0.7782974421192767
0.09576622809206847
0.4099764488429094
0.6312457112010281
0.7653133648911961
0.515606699960211
0.04678935328563483
0.440639621831668
0.7812690838286037
0.9911459739161296
0.8492790031140809
0.05998630544276218
0.7667251981437075
0.7249065625694016
0.7546829077682189
0.2014314571693834
0.323838572852246
0.5970788423663675
0.9771135628945475
0.4514283397368585
0.4963054028398532
0.9716561385393364
0.7630045921004902
0.9797653333483775
0.20283133878472
0.03166861326167403
0.1581480286952355
0.7197034018849273
0.7772823617179596
0.6449577783675171
0.3380646585783239
0.6546523281219516
0.0456563493426857
0.8674847800881136
0.1029617494881166
0.9469693357004212
0.379497748848172
0.1345208960036298
0.312879832834512
0.8986840911360741
0.7807903970820254
0.1930413238649759
0.1739408279320189
0.893316219824227
0.7707645075743599
0.792116942050586
0.2135578525120772
0.1933726762091043
0.6467390825720987
0.1112869369577927
0.5059125207258039
0.6849215724339455
0.1570275682106105
0.3733746363000563
0.808372197161161
0.9093219312432421
0.1606895364840794
0.7379478820768828
0.5556956333212771
0.1878565968914672
0.6900143540527558
0.2998163131210611
0.6322680775669917
0.2357835014342674
0.4893431008361042
0.7582642166423046
0.6202074195843946
0.2477752804337469
0.6532079176795309
0.330785884081767
0.1192031611451035
0.6568562030968705
0.9473198884988218
0.8411543373575909
0.1463880717783439
0.687492784344319
0.6642130838728434
0.5104891837342258
0.4347218932056857
0.3835882638111207
0.8422942344656256
0.2508350181598343
0.291479801013163
0.5609688492709797
0.6266636903357052
0.4497194561502447
0.8644253224921107
0.9539571195922825
0.8165273418664679
0.7200631120940203
0.1220418066544595
0.08295422783201245
0.8391233359899599
0.350551199871815
0.9056369578551801
0.5778913994332658
0.05108653255361029
0.2156540740248768
0.1466845654599992
0.4163013408684876
0.8775582914885607
0.09295870566823849
0.929844942371153
0.9358377175184789
0.2653579348753746
0.03567886971029466
0.4664672183794293
0.584379997191826
0.7267427938994847
0.3334943690987374
0.0636822667271657
0.8916374977505059
0.8289625823503145
0.3729495826401348
0.76546316699376
0.4374009610660129
0.5182717138717996
0.5601889269064096
0.2455058815656616
0.1283052887658608
0.6104832892269054
0.6135677069786908
0.2349313039830699
0.8576099510301763
0.1153046731208617
0.8825150168947148
0.3889091105363364
0.2998224380212881
0.7529141431174664
0.2651695014510056
0.5255483245397433
0.2292347177205935
0.05638555118628963
0.8277810519354888
0.1158141136934723
0.5419230010306129
0.6246839658097595
0.0003758221893939151
0.1636151201806123
0.009516564582797704
0.7530014547485532
0.7037097547081718
0.3563410607801362
0.6704121147543829
0.09099505423899557
0.822654990430608
0.4232199741672384
0.1015881886513316
0.09758935582897554
0.106357329408205
0.6186988764147504
0.2009873519296198
0.4231980358035324
0.8090221535471258
0.3289164724718036
0.2733498264353648
0.8188288111996195
0.2064663927600562
0.6545668472417844
0.5760130779369724
0.5637127671125171
0.3146774861323062
0.145663820743122
0.1302168471104906
0.8426667069952698
0.4746116895568181
0.2316973493627692
0.7810420524673425
0.682424363146733
0.1612185648578367
0.1411937164850225
0.6687428305148433
0.6587328847758418
0.6438059367000052
0.1867879628371164
0.822098464780699
0.6137460751304099
0.9322219893430503
0.6614161590597856
0.2492031648627455
0.0466922013939649
0.03714053702677689
0.7182692437787263
0.2434180984491574
0.1456763168318614
0.04395515177802145
0.8088304531108501
0.8407237481089014
0.2295170301368117
0.7478390463100749
0.2819469376488415
0.3382515133079037
0.329206178196116
0.06663440526041897
0.07715345338561841
0.4948316295525573
0.376096669400761
0.4165866487819505
0.6196851777911678
0.6635295287371097
0.6355091145735927
0.340201638270653
0.7447552427861331
0.6955056002586417
0.5865770460551188
0.8827422705066625
0.9572091918107977
0.8600791672765772
0.3203623442153978
0.663587983731134
0.9056326469920711
0.6854112064039103
0.9991247584365847
0.4993940317059458
0.2728997171042178
0.6934103342318307
0.9950125284800352
0.2103776072150774
0.4157307331727811
0.162007507128176
0.2497219771078316
0.3937076822577935
0.3401666606419359
0.9285248836676876
0.4527238537431563
0.5265665766525548
0.501154125125536
0.810326381468528
0.804838200476692
0.1178208323109059
0.6183502289206068
0.7727275226556869
0.2848384548598178
0.269120237835473
0.4661162532708516
0.3712503248353668
0.4792406667886745
0.438207686734609
0.2552261958636121
0.1411376436401548
0.2661719595391222
0.3484837222058765
0.2525219650158795
0.01771802843293302
0.4507474890824889
0.9045816956523666
0.6570649843686319
0.1434323809846046
0.2584968365853021
0.7912647156990554
0.7273798901788984
0.8231185254316261
0.9363027725223539
0.1911715920084949
0.5269436607084196
0.2806099606082405
0.4083874267944586
0.2398529075455589
0.3575555817756102
0.1643209913064337
0.002529694477878874
0.4066580273188295
0.2796176688333473
0.1772755202620809
0.5856579770625748
0.7215181888323551
0.7212609147088103
0.5085861196357225
0.3259258294188844
0.4548378972555756
0.2968805983357771
0.683026854068294
0.924728143195075
0.2917456526722308
0.4759942350699736
0.3915443411108871
0.3188958843098935
0.4001858271215152
0.8775925398524255
0.953160377075742
0.004383438254457861
0.6014281395920986
0.7855776162110845
0.638506626625535
0.1170147906110954
0.7105127640545864
0.09774973858131786
0.5847656084539119
0.847564771084339
0.2307253695522218
0.1959879126661013
0.03782815753379265
0.8275467009741005
0.02826167377201394
0.3672386110452862
0.1748114663644544
0.5040730091568748
0.4959861980024814
0.8648814337000932
0.5711395831148516
0.1710155814627483
0.908353001332888
0.6636377269472585
0.5026889918923206
0.822084970197406
0.2876968378562964
0.8809650972655474
0.5314381385927962
0.09259364379360935
0.483544266284841
0.3217971523537261
0.5430806465734219
0.9567038750605196
0.3675241776002314
0.0264606839837801
0.7395105386133489
0.3248849680766279
0.6652865344284973
0.4978462949187131
0.8576851725762095
0.7486319656703316
0.397915820333789
0.5141143552584124
0.583756327905349
0.508243785545476
0.7338708097051049
0.7285900667380094
0.1941297362134017
0.4548926820793441
0.5186163053312298
0.1490857610670967
0.7819399415124049
0.1654329795363289
0.4952239610952458
0.259175029738592
0.6217587369746963
0.4571117744922188
0.2554557911182781
0.534400622572249
0.0916214964714942
0.5615329843565661
0.8521998769242128
0.7274906027740951
0.538697511160083
0.6716170759046064
0.8606825174849109
0.5519277130187896
0.9106831152828662
0.556749508305831
0.8583378261592052
0.4527628055743045
0.1606159062978054
0.2372150937945338
0.6117433752740724
0.4337217066993081
0.6071553148947922
0.2366558351357411
0.9335249339773627
0.7034089547854145
0.6756352577441201
0.3936358143251755
0.647503736778851
0.4492551505341909
0.9899717968300691
0.09361481278584982
0.4683740521685751
0.6936822309514781
0.9418181990364669
0.6315116588193715
0.6171159871805773
0.6435289018067313
0.1515327368058428
0.2446682262409852
0.550142288677071
0.2413076178884336
0.504063842083072
0.8012518379799675
0.6635150382125796
0.03677336451486346
0.2080297701871255
0.4031231509650309
0.9182382266179694
0.6079913868244774
0.2182999747675104
0.3489155003696005
0.267919380367911
0.3853859275473615
0.8782751137419897
0.5550247762374826
0.3249080661048463
0.6485357418472696
0.6104036193905655
0.08896262914304942
0.3668054873725067
0.9399524249625995
0.9228135125663498
0.2608572885418904
0.2645732915529539
0.7803307972048107
0.4019077916097313
0.8864559166254603
0.4521870639765907
0.4969885267327371
0.3729618660688859
0.3817095419085867
0.4580856509131209
0.7177849457649941
0.7299512684954235
0.3361320631624437
0.4642979460372829
0.3777057126165045
0.06394982480760314
0.9827019537674155
0.5962931821893948
0.4501368340000427
0.9720105885974949
0.6886543936772321
0.4879833687365164
0.3573464608417309
0.4314879451813104
0.2061947707047214
0.544849909479693
0.957502087527355
0.1870051696688149
0.7702047953380905
0.8373805010443406
0.9083137403555017
0.6306630706764909
0.5935944489250058
0.772602644287646
0.273068648621246
0.008237615043091839
0.2684188046996536
0.5338546391936502
0.2251411314700431
0.9124910119183312
0.1127385410328676
0.2663420432107302
0.4797960675956973
0.6609343229049219
0.8359470913117386
0.6347127303056589
0.8068406169449454
0.5724203364097281
0.4917113069131129
0.8015136673170312
0.4410514004968902
0.04886972718564164
0.9874602909057569
0.7492494783451867
0.5786447718377037
0.3341665882720505
0.5933519929178346
0.9016442919835091
0.8429451403179621
0.8684161339212322
0.1036371983984848
0.7873106094963864
0.4059608946523245
0.3069668456809448
0.02652032457650355
0.7104558756456958
0.843627569565131
0.04988780528223968
0.2456314030551109
0.9501568138056644
0.1100803841005638
0.9579749882722481
0.3453860336573168
0.8804481961571243
0.276029507490185
0.714448536660363
0.04971574474905371
0.107253562155779
0.8589907535298285
0.4242794681117714
0.5625256850056726
0.7327245943047813
0.9608829824610809
0.05913498388986971
0.1195660880149612
0.1308001516365505
0.8027205155165122
0.1601708571685636
0.525530254482209
0.7085921529173865
0.9903962005245053
0.610435169301708
0.2915822973187088
0.5508801636006813
0.5407105899912373
0.9005162708607162
0.07092864553697709
0.9837516060325393
0.9056940050639519
0.9389926070526617
0.6718603982545037
0.7265535208169442
0.0933698254443055
0.1354734015956748
0.8106430816074579
0.8452925958076646
0.1029718616276447
0.7558966611123731
0.3211737537593129
0.2382375670573051
0.8395999288988436
0.4214440948097979
0.6599587717680374
0.0357786992124387
0.7408030629544039
0.9975665866873257
0.3841472763912928
0.5292566409536741
0.7841642484111793
0.1622008024146887
0.9014195152987644
0.3102880354659415
0.6793093142257626
0.4591853794841392
0.6641840880605209
0.6828983170592361
0.2423286846882906
0.5437299650789259
0.1642296324342992
0.9065886607123872
0.5727220180425645
0.8452807889795116
0.9757021898067603
0.7963676855366463
0.5541240349234611
0.8731062874194454
0.2675530206890216
0.9410650048908729
0.9902633996160738
0.9173703861819479
0.03720207222203964
0.585980306873088
0.4210069757396099
0.04552947824773679
0.9252143099375978
0.7513460745875381
0.06039859244898627
0.7221340353316433
0.2863320028626405
0.9644735721057532
0.1493308817207637
0.5972034228159512
0.4651686965233579
0.4113363793156002
0.880488962719551
0.2248881876192546
0.5429623138802556
0.9476024643853722
0.6533406662893882
0.03409708326709815
0.3888555956517826
0.8739194227433489
0.3883120052345878
0.7469069210920392
0.7411060147495505
0.2297779473787719
0.9238020351193297
0.1720405432598824
0.8302527202181416
0.4108445096714834
0.7703368371497962
0.3400218830229882
0.89133524160372
0.8554264299700676
0.1319030676290006
0.6823661705663632
0.1495795268947909
0.4103679594088759
0.549947684939901
0.5518026588008819
0.7729981529023365
0.7407500887878584
0.9076753726373387
0.463715278605034
0.4008031571785572
0.94390109594086
0.09561478482071539
0.5587475596808567
0.3173953170120756
0.9447706510959202
0.618901958552541
0.4643858491800936
0.8790315351843209
0.7326852066642277
0.5892154311003451
0.1006443569792121
0.02187828055803398
0.08429697467758346
0.455152772646203
0.1883186345854497
0.07512579075822712
0.3290667104090407
0.227286979231096
0.3371710268882941
0.5524473740531782
0.9683113444471438
0.2272296837480325
0.4001456655973323
0.9907714531844382
0.4620185041248831
0.9845304523123836
0.4984403195875649
0.9880039096795565
0.5380994022812072
0.1328964933929179
0.3392031981587114
0.7290083161041685
0.4156438777036031
0.9247214317594548
0.07029164643746133
0.3793955628776755
0.5651590175733986
0.7565917862341232
0.7336655623419102
0.3812448957453333
0.9046564148882535
0.1930206576469395
0.890348095003441
0.2581756950794387
0.4136571297761859
0.003279341921906376
0.5458363342462074
0.3450070711007081
0.645588023619165
0.9321854818646257
0.587708283878026
0.2606030116912819
0.8999458527288274
0.01724623569096306
0.2279211373480438
0.7168581927040588
0.09962785372575234
0.7170175218036562
0.239580553677171
0.4128389087974799
0.2894398680546381
0.1516182588032814
0.3098016405349268
0.6334393020407166
0.0225924003937511
0.6241597991633951
0.2001888220806741
0.3970564042577788
0.4658305674043748
0.7983575444901186
0.2210043574434539
0.3823859561792219
0.9067874357260439
0.1238760764205172
0.04505731714950123
0.6896037939199376
0.2981209403072959
0.9965603320468314
0.1839315335947156
0.5551467463756341
0.5912984665067248
0.4990368060573562
0.4625596909469145
0.1527691149526219
0.2585588267018007
0.722380433394533
0.9963474143400639
0.555310311717323
0.6436788167270254
0.6808067150605602
0.9528096155865931
0.366399040866368
0.4692217889010913
0.1285397079243911
0.07980670213439545
0.5440081248219508
0.6723069580592883
0.8435069479919347
0.5983247521188737
0.06240111773359736
0.7376456137915793
0.1535854494742722
0.08510737131666235
0.04900699038614942
0.08040319634877813
0.2132904975354085
0.3885382750650893
0.2879823804891476
0.149711341131578
0.6338170036276467
0.1136909175028815
0.7344814280504979
0.8900224066623255
0.4429103024948694
0.4080863910506083
0.4138534977830822
0.8787018888665857
0.5272162521030758
0.1277437970543398
0.2115361274021211
0.1682475886746375
0.3547241074161448
0.3645586859516743
0.5516767534499161
0.1313418680595633
0.7103877272769868
0.3549878091845877
0.6470802080237382
0.4252830218048486
0.7573350173556445
0.242964184989073
0.1884441963376879
0.152735920449503
0.9912138122536411
0.9747191639555511
0.9221012006299496
0.4513026900841971
0.2018011071569559
0.3755671620412094
0.7431663128128615
0.9011007821374826
0.8604532939481959
0.9732889792898411
0.1515051392944925
0.1231577170247805
0.1938042495344156
0.2576290884056766
0.7281770932543058
0.2233662299354708
0.5970421867919924
0.1740885607824549
0.5752213207739252
0.4589827786960482
0.8829379726213226
0.006501989511032313
0.3674111613507309
0.1627369210179049
0.07629164837894686
0.9011506256347845
0.4278916184425381
0.5464766480411437
0.08703734802115193
0.5888957426324904
0.4078853370269363
0.6125779380187373
0.04034667611491349
0.04796805989424602
0.4574224643019429
0.8195271555865545
0.6988519853845492
0.5499447786681219
0.2009257036945957
0.6379872347197878
0.04532951009823127
0.720745666531769
0.4243044604981899
0.5157910609573652
0.91128073571204
0.749633768749228
0.9620748856691238
0.7573750368828713
0.4380880292722591
0.4554971759546693
0.5115828492131747
0.2336100941540931
0.4396866910270356
0.1442177885988739
0.5233882393745927
0.4037952356791581
0.05496364571117429
0.3643221764090653
0.09857597627000225
0.6099688493956323
0.2234008363868244
0.5806664147443227
0.3305101471124651
0.7464947194121648
0.7816067588025728
0.1191345263088943
0.4309887387817847
0.1453443234602514
0.09950881635531528
0.5136754513992725
0.1850545269351187
0.7252774066361717
0.03860883695316963
0.1752468586988707
0.8486341447647672
0.8299088350679383
0.2039615883228973
0.487527623521674
0.53543582114243
0.195502353530067
0.9141867671125131
0.2827732453397999
0.9510484049697426
0.6831683288993847
0.6179100932285354
0.5487318386700291
0.7779540956688812
0.2331930599595876
0.1165761976026892
0.3534281644941153
0.09962006625810271
0.3808369455539417
0.9779930182547943
0.6141110769144189
0.5759224942521924
0.4497125130176507
0.4457740797200458
0.4074422940412931
0.8985862404382988
0.4163415492366074
0.6801558147747342
0.03595588493427715
0.1780712709274711
0.09390881730226441
0.1251961972191801
0.1885289689399452
0.4654407735780366
0.1717734025725587
0.5210537442009584
0.6752911763542996
0.8688897205303052
0.7569369347440458
0.9842317524892046
0.2198400234887553
0.1729985576702801
0.9227279677718779
0.8989372598606983
0.3771974418426111
0.1371985611917274
0.1422537347907288
0.006771806362500077
0.8079297245860473
0.8248055369131398
0.9149561743850259
0.3489427142543103
0.4566375067602169
0.6456146340413252
0.6735041746419594
0.9759072204720871
0.6133586650776676
0.9277498563073998
0.9281719119181705
0.9977177938006829
0.2682936175554479
0.9461441383071844
0.1121276488405524
0.8699643510346226
0.1095112076083331
0.8982984497489168
0.6351931461255053
0.600993799383576
0.4684217342589907
0.5139049878682951
0.5447730904035982
0.6902472899025476
0.5630294749734774
0.2038726556122153
0.3751768438010991
0.6308558703217668
0.5151615182339797
0.1288018601899773
0.8298101219322016
0.839440967003994
0.3234764871651495
0.1583903614450823
0.8571778049459723
0.3174481397804656
0.2696351435791805
0.8606062969883559
0.8012199896612426
0.2624697588277912
0.8988531217544283
0.1258892404305789
0.856530667272244
0.824722301542086
0.4538728961955311
0.1280941873938473
0.08219871000674905
0.1741676564028491
0.7274547996552254
0.4869730216040211
0.5069247663715388
0.9199431559224166
0.2154667621352669
0.1358514671089676
0.4418951859799259
0.2220836123568398
0.2360694916915373
0.2753974127693433
0.1381188051918542
0.1763801975353066
0.3723195380032993
0.9867292222969875
0.858851072283221
0.7339912282976964
0.5897746183060495
0.2388350997603985
0.2424297014815817
0.01892396867208657
0.8162613334110634
0.7129250081252332
0.774855080991709
0.2957494121915945
0.7983219144308387
0.5086149638394499
0.1179032359705711
0.8761699753538994
0.2054402327378841
0.2919498044012264
0.290843512338408
0.8754440658250308
0.1609870020247226
0.7228097250791012
0.8055655435127642
0.7418323116947004
0.7920853958298709
0.6978214078652053
0.7784006646895765
0.3651852341851732
0.9096724195139992
0.5531571821179198
0.8564322114391404
0.9575107579546778
0.8050970619317351
0.4179613424010368
0.602931412462276
0.5230608541397703
0.6082975208671643
0.1756052389499451
0.5180545360406706
0.4968258050507409
0.8462128245279992
0.5728063619868741
0.1760462368316695
0.1296960734713823
0.6572523871180592
0.2131182831176431
0.4454183128919467
0.7451889204388251
0.6655099590975496
0.2993956222134874
0.7725552573547741
0.3553950843326966
0.09011994505684695
0.7271792629136289
0.7165184456443356
0.08106656997396422
0.7365092971398089
0.08374574535221657
0.8916906194968202
0.8880889400069596
0.569339413599545
0.8470432410221577
0.126624391351658
0.2047112028112729
0.0494695798458733
0.6923815596490981
0.2932860125924376
0.747849573969439
0.5347389537705853
0.3279230146724041
0.9210220143350989
0.8284653803792299
0.5229904770459297
0.1226789374768018
0.09234004878746749
0.6729606461824392
0.7104310442713989
0.9808680774494408
0.9623490072631435
0.4020676694334012
0.1869150094774705
0.3893541449352056
0.8851191767765655
0.595220050541887
0.6281958266891871
0.9606615428215473
0.2397620720805743
0.3180271638439582
0.2862042183926891
0.9180119294100104
0.8085465726326803
0.9774646258871924
0.1730989274254555
0.8051878535702419
0.3643997132742111
0.5618764948692372
0.2884111060777893
0.7186796644505267
0.3285189118722595
0.6769887600430147
0.8335452742397995
0.04250125038574459
0.9641671066042119
0.1321971985711896
0.1368636163526882
0.6524300048632173
0.330119977126648
0.9776348891326024
0.6633411243322815
0.9156368023687225
0.1441733119922266
0.1040439764128109
0.939679264052967
0.7345261675819142
0.02325974047072077
0.1080733142861334
0.1073453262755185
0.2818173248251982
0.8627800344940149
0.1097552393391756
0.5740891559080574
0.921953095784068
0.9783714131053888
0.9044014136257396
0.05067204470479125
0.4124563188961032
0.3116479265299134
0.4232271462047688
0.9147994258273184
0.284657920925413
0.5749506033568685
0.80654393674224
0.7186282076568636
0.9011443825376279
0.05539105146729706
0.8600983421900328
0.007755462065985763
0.7178897954104533
0.7109009935821109
0.1755371619531991
0.8696552300725474
0.1565621867188104
0.9119635583740171
0.2338083581948056
0.6860592982186901
0.6398985073815359
0.1575943296226382
0.2896859218392631
0.1985220085135001
0.9318124141933212
0.540734493604897
0.9525635271231068
0.2174634830507883
0.6450328825132124
0.7862244324460526
0.4002581097510213
0.8367953789981384
0.1630498009350921
0.2033130762594543
0.343979607240712
0.24913003766186
0.3457013930321183
0.9863802929118149
0.6239507558928402
0.5962644696993289
0.5772919605112458
0.4030340194186339
0.5454462192732453
0.777425284122461
0.4704034911374144
0.08838744941293197
0.9339043281090493
0.04359847705705266
0.6486963416824907
0.733022827726627
0.09322381056555762
0.7855471679755759
0.9248241465898298
0.564250343611759
0.4542472392637262
0.7935355811161912
0.2837788120962224
0.9921018450276777
0.9859792792632424
0.5361795572443926
0.894398466519281
0.2355512730052551
0.4785062946389778
0.9075672387352698
0.6637445253262119
0.43575429373567
0.8539885798482977
0.3960352894920703
0.4686050727239756
0.4499991536423141
0.3239841943808175
0.8708194178746103
0.8832952243422918
0.3430104732742003
0.953920849572316
0.3097282675514356
0.9315138444605948
0.1618978678047657
0.9529393913250206
0.8785188902780843
0.5071705495410398
0.0182444328293786
0.7781547798320358
0.3594572370063724
0.8485491814773263
0.4330620445666292
0.6057818975358047
0.3775799877867961
0.7214100118518808
0.3161731776518653
0.9493514815474066
0.8497458596362656
0.7755979107193002
0.2995165701224971
0.8726990313866313
0.3750827935548919
0.7984195795922602
0.8167874313179456
0.9990129576223229
0.04508877467261807
0.2368026674609457
0.4309058710185842
0.8472399861525521
0.3864352382555887
0.1228069079889299
0.91526185373976
0.1823276543858223
0.5907768634355596
0.8123503247282398
0.2611611475616882
0.985808374756683
0.4412568741065448
0.2252607389802863
0.1847185394374565
0.6982403285717427
0.8751954585254841
0.7689644203263455
0.2614347125582023
0.9857058733591394
0.0441839926335158
0.3441463352947595
0.6731849009464091
0.05673416616913241
0.0545707441021237
0.5648652864788175
0.6509464265538195
0.2370277990419545
0.6269163722820162
0.5300383483457375
0.5142838090737361
0.7016276480583008
0.3736906602422265
0.614033077192303
0.3072869214703424
0.09289696354121046
0.6629214533628009
0.02857520429375648
0.3845448310745404
0.07205191193223814
0.2919184436175765
0.2131595702819035
0.7219973963983469
0.7050250255312476
0.715119919964416
0.3612226449671331
0.5464699797189634
0.3578320102602714
0.9409564116975221
0.4447915352855814
0.1108189395388685
0.8651217656218272
0.03555498797387979
0.2232636532845561
0.1379628655344118
0.3025751230314925
0.254191780954881
0.7311838341926741
0.6376858890976999
0.9752451102282299
0.331082019914313
0.4206910061076482
0.4804255309916361
0.9098342394001943
0.5721246787406048
0.4248358459379435
0.4544178516547929
0.9512078349786919
0.5829458827501757
0.3914352979129718
0.55807778382827
0.9865541073911297
0.7836230392014071
0.08822244423271108
0.3784976622621585
0.7695046155032698
0.1994075438199825
0.3530758331132451
0.2176785000854113
0.003305149718622058
0.1916251113742494
0.4502385355767271
0.6818289194038245
0.4680664799083314
0.1283756856694626
0.8036842883103122
0.07597296795310371
0.1230780971469906
0.8710573958860452
0.6854396413490149
0.5119075462645981
0.6164991191381864
0.8325470008698309
0.01056815712884707
0.5220068211431076
0.3838587544826066
0.05875556671519977
0.7143045209857067
0.7781156166156741
0.7166497352188371
0.1198503775894584
0.3236295747251323
0.8661837429267558
0.6751686521481957
0.2393158308123208
0.02847464195493121
0.2638564538068605
0.7485575826817396
0.4308182999610547
0.9501830906164783
0.08448402435248026
0.01642846671830112
0.6146099219645
0.2135161596821766
0.7536603197850679
0.7120532801956408
0.4065295252711001
0.2429310746985222
0.5293116776533238
0.7923727729025613
0.7715423186598903
0.3729520325404124
arpack-ng-3.1.5/TESTS/Makefile.in 0000644 0001750 0001750 00000075151 12277667632 013306 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
check_PROGRAMS = dnsimp$(EXEEXT) bug_1323$(EXEEXT)
TESTS = dnsimp$(EXEEXT) bug_1323$(EXEEXT)
subdir = TESTS
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \
$(top_srcdir)/test-driver
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am_bug_1323_OBJECTS = bug_1323.$(OBJEXT)
bug_1323_OBJECTS = $(am_bug_1323_OBJECTS)
am__DEPENDENCIES_1 =
bug_1323_DEPENDENCIES = ../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_dnsimp_OBJECTS = dnsimp.$(OBJEXT) mmio.$(OBJEXT)
dnsimp_OBJECTS = $(am_dnsimp_OBJECTS)
dnsimp_DEPENDENCIES = ../libarpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
$(AM_CFLAGS) $(CFLAGS)
AM_V_CC = $(am__v_CC_@AM_V@)
am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@)
am__v_CC_0 = @echo " CC " $@;
am__v_CC_1 =
CCLD = $(CC)
LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_CCLD = $(am__v_CCLD_@AM_V@)
am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@)
am__v_CCLD_0 = @echo " CCLD " $@;
am__v_CCLD_1 =
SOURCES = $(bug_1323_SOURCES) $(dnsimp_SOURCES)
DIST_SOURCES = $(bug_1323_SOURCES) $(dnsimp_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
am__tty_colors_dummy = \
mgn= red= grn= lgn= blu= brg= std=; \
am__color_tests=no
am__tty_colors = { \
$(am__tty_colors_dummy); \
if test "X$(AM_COLOR_TESTS)" = Xno; then \
am__color_tests=no; \
elif test "X$(AM_COLOR_TESTS)" = Xalways; then \
am__color_tests=yes; \
elif test "X$$TERM" != Xdumb && { test -t 1; } 2>/dev/null; then \
am__color_tests=yes; \
fi; \
if test $$am__color_tests = yes; then \
red='[0;31m'; \
grn='[0;32m'; \
lgn='[1;32m'; \
blu='[1;34m'; \
mgn='[0;35m'; \
brg='[1m'; \
std='[m'; \
fi; \
}
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__recheck_rx = ^[ ]*:recheck:[ ]*
am__global_test_result_rx = ^[ ]*:global-test-result:[ ]*
am__copy_in_global_log_rx = ^[ ]*:copy-in-global-log:[ ]*
# A command that, given a newline-separated list of test names on the
# standard input, print the name of the tests that are to be re-run
# upon "make recheck".
am__list_recheck_tests = $(AWK) '{ \
recheck = 1; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
{ \
if ((getline line2 < ($$0 ".log")) < 0) \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[nN][Oo]/) \
{ \
recheck = 0; \
break; \
} \
else if (line ~ /$(am__recheck_rx)[yY][eE][sS]/) \
{ \
break; \
} \
}; \
if (recheck) \
print $$0; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# A command that, given a newline-separated list of test names on the
# standard input, create the global log from their .trs and .log files.
am__create_global_log = $(AWK) ' \
function fatal(msg) \
{ \
print "fatal: making $@: " msg | "cat >&2"; \
exit 1; \
} \
function rst_section(header) \
{ \
print header; \
len = length(header); \
for (i = 1; i <= len; i = i + 1) \
printf "="; \
printf "\n\n"; \
} \
{ \
copy_in_global_log = 1; \
global_test_result = "RUN"; \
while ((rc = (getline line < ($$0 ".trs"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".trs"); \
if (line ~ /$(am__global_test_result_rx)/) \
{ \
sub("$(am__global_test_result_rx)", "", line); \
sub("[ ]*$$", "", line); \
global_test_result = line; \
} \
else if (line ~ /$(am__copy_in_global_log_rx)[nN][oO]/) \
copy_in_global_log = 0; \
}; \
if (copy_in_global_log) \
{ \
rst_section(global_test_result ": " $$0); \
while ((rc = (getline line < ($$0 ".log"))) != 0) \
{ \
if (rc < 0) \
fatal("failed to read from " $$0 ".log"); \
print line; \
}; \
printf "\n"; \
}; \
close ($$0 ".trs"); \
close ($$0 ".log"); \
}'
# Restructured Text title.
am__rst_title = { sed 's/.*/ & /;h;s/./=/g;p;x;s/ *$$//;p;g' && echo; }
# Solaris 10 'make', and several other traditional 'make' implementations,
# pass "-e" to $(SHELL), and POSIX 2008 even requires this. Work around it
# by disabling -e (using the XSI extension "set +e") if it's set.
am__sh_e_setup = case $$- in *e*) set +e;; esac
# Default flags passed to test drivers.
am__common_driver_flags = \
--color-tests "$$am__color_tests" \
--enable-hard-errors "$$am__enable_hard_errors" \
--expect-failure "$$am__expect_failure"
# To be inserted before the command running the test. Creates the
# directory for the log if needed. Stores in $dir the directory
# containing $f, in $tst the test, in $log the log. Executes the
# developer- defined test setup AM_TESTS_ENVIRONMENT (if any), and
# passes TESTS_ENVIRONMENT. Set up options for the wrapper that
# will run the test scripts (or their associated LOG_COMPILER, if
# thy have one).
am__check_pre = \
$(am__sh_e_setup); \
$(am__vpath_adj_setup) $(am__vpath_adj) \
$(am__tty_colors); \
srcdir=$(srcdir); export srcdir; \
case "$@" in \
*/*) am__odir=`echo "./$@" | sed 's|/[^/]*$$||'`;; \
*) am__odir=.;; \
esac; \
test "x$$am__odir" = x"." || test -d "$$am__odir" \
|| $(MKDIR_P) "$$am__odir" || exit $$?; \
if test -f "./$$f"; then dir=./; \
elif test -f "$$f"; then dir=; \
else dir="$(srcdir)/"; fi; \
tst=$$dir$$f; log='$@'; \
if test -n '$(DISABLE_HARD_ERRORS)'; then \
am__enable_hard_errors=no; \
else \
am__enable_hard_errors=yes; \
fi; \
case " $(XFAIL_TESTS) " in \
*[\ \ ]$$f[\ \ ]* | *[\ \ ]$$dir$$f[\ \ ]*) \
am__expect_failure=yes;; \
*) \
am__expect_failure=no;; \
esac; \
$(AM_TESTS_ENVIRONMENT) $(TESTS_ENVIRONMENT)
# A shell command to get the names of the tests scripts with any registered
# extension removed (i.e., equivalently, the names of the test logs, with
# the '.log' extension removed). The result is saved in the shell variable
# '$bases'. This honors runtime overriding of TESTS and TEST_LOGS. Sadly,
# we cannot use something simpler, involving e.g., "$(TEST_LOGS:.log=)",
# since that might cause problem with VPATH rewrites for suffix-less tests.
# See also 'test-harness-vpath-rewrite.sh' and 'test-trs-basic.sh'.
am__set_TESTS_bases = \
bases='$(TEST_LOGS)'; \
bases=`for i in $$bases; do echo $$i; done | sed 's/\.log$$//'`; \
bases=`echo $$bases`
RECHECK_LOGS = $(TEST_LOGS)
AM_RECURSIVE_TARGETS = check recheck
TEST_SUITE_LOG = test-suite.log
TEST_EXTENSIONS = @EXEEXT@ .test
LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
LOG_COMPILE = $(LOG_COMPILER) $(AM_LOG_FLAGS) $(LOG_FLAGS)
am__set_b = \
case '$@' in \
*/*) \
case '$*' in \
*/*) b='$*';; \
*) b=`echo '$@' | sed 's/\.log$$//'`; \
esac;; \
*) \
b='$*';; \
esac
am__test_logs1 = $(TESTS:=.log)
am__test_logs2 = $(am__test_logs1:@EXEEXT@.log=.log)
TEST_LOGS = $(am__test_logs2:.test.log=.log)
TEST_LOG_DRIVER = $(SHELL) $(top_srcdir)/test-driver
TEST_LOG_COMPILE = $(TEST_LOG_COMPILER) $(AM_TEST_LOG_FLAGS) \
$(TEST_LOG_FLAGS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
dnsimp_SOURCES = dnsimp.f mmio.f debug.h
dnsimp_LDADD = ../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = testA.mtx
bug_1323_SOURCES = bug_1323.f
bug_1323_LDADD = ../libarpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .log .o .obj .test .test$(EXEEXT) .trs
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign TESTS/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign TESTS/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-checkPROGRAMS:
@list='$(check_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
bug_1323$(EXEEXT): $(bug_1323_OBJECTS) $(bug_1323_DEPENDENCIES) $(EXTRA_bug_1323_DEPENDENCIES)
@rm -f bug_1323$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(bug_1323_OBJECTS) $(bug_1323_LDADD) $(LIBS)
dnsimp$(EXEEXT): $(dnsimp_OBJECTS) $(dnsimp_DEPENDENCIES) $(EXTRA_dnsimp_DEPENDENCIES)
@rm -f dnsimp$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(dnsimp_OBJECTS) $(dnsimp_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
# Recover from deleted '.trs' file; this should ensure that
# "rm -f foo.log; make foo.trs" re-run 'foo.test', and re-create
# both 'foo.log' and 'foo.trs'. Break the recipe in two subshells
# to avoid problems with "make -n".
.log.trs:
rm -f $< $@
$(MAKE) $(AM_MAKEFLAGS) $<
# Leading 'am--fnord' is there to ensure the list of targets does not
# expand to empty, as could happen e.g. with make check TESTS=''.
am--fnord $(TEST_LOGS) $(TEST_LOGS:.log=.trs): $(am__force_recheck)
am--force-recheck:
@:
$(TEST_SUITE_LOG): $(TEST_LOGS)
@$(am__set_TESTS_bases); \
am__f_ok () { test -f "$$1" && test -r "$$1"; }; \
redo_bases=`for i in $$bases; do \
am__f_ok $$i.trs && am__f_ok $$i.log || echo $$i; \
done`; \
if test -n "$$redo_bases"; then \
redo_logs=`for i in $$redo_bases; do echo $$i.log; done`; \
redo_results=`for i in $$redo_bases; do echo $$i.trs; done`; \
if $(am__make_dryrun); then :; else \
rm -f $$redo_logs && rm -f $$redo_results || exit 1; \
fi; \
fi; \
if test -n "$$am__remaking_logs"; then \
echo "fatal: making $(TEST_SUITE_LOG): possible infinite" \
"recursion detected" >&2; \
else \
am__remaking_logs=yes $(MAKE) $(AM_MAKEFLAGS) $$redo_logs; \
fi; \
if $(am__make_dryrun); then :; else \
st=0; \
errmsg="fatal: making $(TEST_SUITE_LOG): failed to create"; \
for i in $$redo_bases; do \
test -f $$i.trs && test -r $$i.trs \
|| { echo "$$errmsg $$i.trs" >&2; st=1; }; \
test -f $$i.log && test -r $$i.log \
|| { echo "$$errmsg $$i.log" >&2; st=1; }; \
done; \
test $$st -eq 0 || exit 1; \
fi
@$(am__sh_e_setup); $(am__tty_colors); $(am__set_TESTS_bases); \
ws='[ ]'; \
results=`for b in $$bases; do echo $$b.trs; done`; \
test -n "$$results" || results=/dev/null; \
all=` grep "^$$ws*:test-result:" $$results | wc -l`; \
pass=` grep "^$$ws*:test-result:$$ws*PASS" $$results | wc -l`; \
fail=` grep "^$$ws*:test-result:$$ws*FAIL" $$results | wc -l`; \
skip=` grep "^$$ws*:test-result:$$ws*SKIP" $$results | wc -l`; \
xfail=`grep "^$$ws*:test-result:$$ws*XFAIL" $$results | wc -l`; \
xpass=`grep "^$$ws*:test-result:$$ws*XPASS" $$results | wc -l`; \
error=`grep "^$$ws*:test-result:$$ws*ERROR" $$results | wc -l`; \
if test `expr $$fail + $$xpass + $$error` -eq 0; then \
success=true; \
else \
success=false; \
fi; \
br='==================='; br=$$br$$br$$br$$br; \
result_count () \
{ \
if test x"$$1" = x"--maybe-color"; then \
maybe_colorize=yes; \
elif test x"$$1" = x"--no-color"; then \
maybe_colorize=no; \
else \
echo "$@: invalid 'result_count' usage" >&2; exit 4; \
fi; \
shift; \
desc=$$1 count=$$2; \
if test $$maybe_colorize = yes && test $$count -gt 0; then \
color_start=$$3 color_end=$$std; \
else \
color_start= color_end=; \
fi; \
echo "$${color_start}# $$desc $$count$${color_end}"; \
}; \
create_testsuite_report () \
{ \
result_count $$1 "TOTAL:" $$all "$$brg"; \
result_count $$1 "PASS: " $$pass "$$grn"; \
result_count $$1 "SKIP: " $$skip "$$blu"; \
result_count $$1 "XFAIL:" $$xfail "$$lgn"; \
result_count $$1 "FAIL: " $$fail "$$red"; \
result_count $$1 "XPASS:" $$xpass "$$red"; \
result_count $$1 "ERROR:" $$error "$$mgn"; \
}; \
{ \
echo "$(PACKAGE_STRING): $(subdir)/$(TEST_SUITE_LOG)" | \
$(am__rst_title); \
create_testsuite_report --no-color; \
echo; \
echo ".. contents:: :depth: 2"; \
echo; \
for b in $$bases; do echo $$b; done \
| $(am__create_global_log); \
} >$(TEST_SUITE_LOG).tmp || exit 1; \
mv $(TEST_SUITE_LOG).tmp $(TEST_SUITE_LOG); \
if $$success; then \
col="$$grn"; \
else \
col="$$red"; \
test x"$$VERBOSE" = x || cat $(TEST_SUITE_LOG); \
fi; \
echo "$${col}$$br$${std}"; \
echo "$${col}Testsuite summary for $(PACKAGE_STRING)$${std}"; \
echo "$${col}$$br$${std}"; \
create_testsuite_report --maybe-color; \
echo "$$col$$br$$std"; \
if $$success; then :; else \
echo "$${col}See $(subdir)/$(TEST_SUITE_LOG)$${std}"; \
if test -n "$(PACKAGE_BUGREPORT)"; then \
echo "$${col}Please report to $(PACKAGE_BUGREPORT)$${std}"; \
fi; \
echo "$$col$$br$$std"; \
fi; \
$$success || exit 1
check-TESTS:
@list='$(RECHECK_LOGS)'; test -z "$$list" || rm -f $$list
@list='$(RECHECK_LOGS:.log=.trs)'; test -z "$$list" || rm -f $$list
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
log_list=`for i in $$bases; do echo $$i.log; done`; \
trs_list=`for i in $$bases; do echo $$i.trs; done`; \
log_list=`echo $$log_list`; trs_list=`echo $$trs_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) TEST_LOGS="$$log_list"; \
exit $$?;
recheck: all $(check_PROGRAMS)
@test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
@set +e; $(am__set_TESTS_bases); \
bases=`for i in $$bases; do echo $$i; done \
| $(am__list_recheck_tests)` || exit 1; \
log_list=`for i in $$bases; do echo $$i.log; done`; \
log_list=`echo $$log_list`; \
$(MAKE) $(AM_MAKEFLAGS) $(TEST_SUITE_LOG) \
am__force_recheck=am--force-recheck \
TEST_LOGS="$$log_list"; \
exit $$?
dnsimp.log: dnsimp$(EXEEXT)
@p='dnsimp$(EXEEXT)'; \
b='dnsimp'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
bug_1323.log: bug_1323$(EXEEXT)
@p='bug_1323$(EXEEXT)'; \
b='bug_1323'; \
$(am__check_pre) $(LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_LOG_DRIVER_FLAGS) $(LOG_DRIVER_FLAGS) -- $(LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
.test.log:
@p='$<'; \
$(am__set_b); \
$(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
--log-file $$b.log --trs-file $$b.trs \
$(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
"$$tst" $(AM_TESTS_FD_REDIRECT)
@am__EXEEXT_TRUE@.test$(EXEEXT).log:
@am__EXEEXT_TRUE@ @p='$<'; \
@am__EXEEXT_TRUE@ $(am__set_b); \
@am__EXEEXT_TRUE@ $(am__check_pre) $(TEST_LOG_DRIVER) --test-name "$$f" \
@am__EXEEXT_TRUE@ --log-file $$b.log --trs-file $$b.trs \
@am__EXEEXT_TRUE@ $(am__common_driver_flags) $(AM_TEST_LOG_DRIVER_FLAGS) $(TEST_LOG_DRIVER_FLAGS) -- $(TEST_LOG_COMPILE) \
@am__EXEEXT_TRUE@ "$$tst" $(AM_TESTS_FD_REDIRECT)
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
$(MAKE) $(AM_MAKEFLAGS) $(check_PROGRAMS)
$(MAKE) $(AM_MAKEFLAGS) check-TESTS
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
-test -z "$(TEST_LOGS)" || rm -f $(TEST_LOGS)
-test -z "$(TEST_LOGS:.log=.trs)" || rm -f $(TEST_LOGS:.log=.trs)
-test -z "$(TEST_SUITE_LOG)" || rm -f $(TEST_SUITE_LOG)
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-checkPROGRAMS clean-generic clean-libtool \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: check-am install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-TESTS check-am clean \
clean-checkPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
recheck tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/TESTS/bug_1323.f 0000644 0001750 0001750 00000035251 12277373057 012625 0000000 0000000 program dseupd_bug_2
c
c dsdrv2 program modified to reveal the bug in 'dseupd()':
c
c * 'implicit none' added
c * rvec = .false. (don't want the eigenvectors)
c * computation of the norm residual has been commented out
c * 5th and 6th original arguments (v and ldv) have been replaced by
c others (z and ldz)
c * z is an allocatable array -- it is claimed that it is not referenced
c * ldz = ldv -- fullfill the requirement that ldz .ge. 1
c
c the following error is expected:
c
c Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
c Backtrace for this error:
c ...
c #3 0x428E36 in dger_ at dger.f:199
c #4 0x4099ED in dseupd_ at dseupd.f:852 (discriminator 4)
c #5 0x401A71 in dseupd_bug_2 at dseupd_bug_2.f:301
c
c É. Canot -- IRISA/CNRS -- Edouard.Canot@irisa.fr
c______________________________________________________________________________
c
c Program to illustrate the idea of reverse communication
c in shift and invert mode for a standard symmetric eigenvalue
c problem. The following program uses the two LAPACK subroutines
c dgttrf.f and dgttrs.f to factor and solve a tridiagonal system of
c equations.
c
c We implement example two of ex-sym.doc in DOCUMENTS directory
c
c\Example-2
c ... Suppose we want to solve A*x = lambda*x in shift-invert mode,
c where A is derived from the central difference discretization
c of the 1-dimensional Laplacian on [0,1] with zero Dirichlet
c boundary condition.
c ... OP = (inv[A - sigma*I]) and B = I.
c ... Use mode 3 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 Ritz vectors.
c dgttrf LAPACK tridiagonal factorization routine.
c dgttrs LAPACK tridiagonal solve routine.
c daxpy daxpy Level 1 BLAS that computes y <- alpha*x+y.
c dnrm2 Level 1 BLAS that computes the norm of a vector.
c av Matrix vector multiplication routine that computes A*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information: @(#)
c FILE: sdrv2.F SID: 2.5 DATE OF SID: 10/17/00 RELEASE: 2
c
c\Remarks
c 1. None
c
c\EndLib
c----------------------------------------------------------------------
c
implicit none
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
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),
& ax(maxn)
logical select(maxncv)
integer iparam(11), ipntr(11), ipiv(maxn)
double precision, allocatable :: z(:,:)
integer :: ldz
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, j, ierr,
& nconv, maxitr, ishfts, mode
logical rvec
Double precision
& sigma, tol, h2
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one, two
parameter (zero = 0.0D+0, one = 1.0D+0,
& two = 2.0D+0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dnrm2
external daxpy, dnrm2, dgttrf, dgttrs
c
c %--------------------%
c | Intrinsic function |
c %--------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | standard eigenvalue problem is solved (BMAT = 'I'. |
c | NEV is the number of eigenvalues (closest to |
c | SIGMA) to be approximated. Since the shift-invert |
c | mode is used, WHICH is set to 'LM'. The user can |
c | modify NEV, NCV, SIGMA to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 1 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 10
if ( n .gt. maxn ) then
print *, ' ERROR with _SDRV2: N is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV2: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV2: NCV is greater than MAXNCV '
go to 9000
end if
c
bmat = 'I'
which = 'LM'
sigma = zero
c
c %--------------------------------------------------%
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 | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
ido = 0
info = 0
c
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 DSAUPD is used |
c | (IPARAM(7) = 3). All these options may be |
c | changed by the user. For details, see the |
c | documentation in DSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 3
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-----------------------------------------------------%
c | Call LAPACK routine to factor (A-SIGMA*I), where A |
c | is the 1-d Laplacian. |
c %-----------------------------------------------------%
c
h2 = one / dble((n+1)*(n+1))
do 20 j=1,n
ad(j) = two / h2 - sigma
adl(j) = -one / h2
20 continue
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 SDRV2.'
print *, ' '
go to 9000
end if
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <-- OP*x = inv[A-sigma*I]*x. |
c | The user only need the linear system |
c | solver here that takes workd(ipntr(1)) |
c | as input, and returns the result to |
c | workd(ipntr(2)). |
c %----------------------------------------%
c
call dcopy (n, workd(ipntr(1)), 1, workd(ipntr(2)), 1)
c
call dgttrs ('Notranspose', n, 1, adl, ad, adu, adu2, ipiv,
& workd(ipntr(2)), n, ierr)
if (ierr .ne. 0) then
print *, ' '
print *, ' Error with _gttrs in _SDRV2. '
print *, ' '
go to 9000
end if
c
c %-----------------------------------------%
c | L O O P B A C K to call DSAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %----------------------------%
c | Error message. Check the |
c | documentation in DSAUPD |
c %----------------------------%
c
print *, ' '
print *, ' Error with _saupd, info = ',info
print *, ' Check documentation of _saupd '
print *, ' '
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .false.
ldz = ldv
c
call dseupd ( rvec, 'All', select, d, z, ldz, sigma,
& bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DSEUPD. |
c %------------------------------------%
c
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd '
print *, ' '
c
else
c
nconv = iparam(5)
CC do 30 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
CC call av(n, v(1,j), ax)
CC call daxpy(n, -d(j,1), v(1,j), 1, ax, 1)
CC d(j,2) = dnrm2(n, ax, 1)
CC d(j,2) = d(j,2) / abs(d(j,1))
c
CC 30 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call dmout(6, nconv, 2, d, maxncv, -6,
& 'Ritz values and relative residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit',
& ' Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, ' _SDRV2 '
print *, ' ====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
end if
c
c %---------------------------%
c | Done with program dsdrv2. |
c %---------------------------%
c
9000 continue
c
end
c
c------------------------------------------------------------------------
c Matrix vector subroutine
c where the matrix is the 1 dimensional discrete Laplacian on
c the interval [0,1] with zero Dirichlet boundary condition.
c
subroutine av (n, v, w)
integer n, j
Double precision
& v(n), w(n), one, two, h2
parameter (one = 1.0D+0, two = 2.0D+0)
c
w(1) = two*v(1) - v(2)
do 100 j = 2,n-1
w(j) = - v(j-1) + two*v(j) - v(j+1)
100 continue
j = n
w(j) = - v(j-1) + two*v(j)
c
c Scale the vector w by (1 / h^2).
c
h2 = one / dble((n+1)*(n+1))
call dscal(n, one/h2, w, 1)
return
end
arpack-ng-3.1.5/aclocal.m4 0000644 0001750 0001750 00000125451 12277667630 012174 0000000 0000000 # generated automatically by aclocal 1.14.1 -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])])
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.69],,
[m4_warning([this file was generated for autoconf 2.69.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically 'autoreconf'.])])
# Copyright (C) 2002-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_AUTOMAKE_VERSION(VERSION)
# ----------------------------
# Automake X.Y traces this macro to ensure aclocal.m4 has been
# generated from the m4 files accompanying Automake X.Y.
# (This private macro should not be called outside this file.)
AC_DEFUN([AM_AUTOMAKE_VERSION],
[am__api_version='1.14'
dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to
dnl require some minimum version. Point them to the right macro.
m4_if([$1], [1.14.1], [],
[AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl
])
# _AM_AUTOCONF_VERSION(VERSION)
# -----------------------------
# aclocal traces this macro to find the Autoconf version.
# This is a private macro too. Using m4_define simplifies
# the logic in aclocal, which can simply ignore this definition.
m4_define([_AM_AUTOCONF_VERSION], [])
# AM_SET_CURRENT_AUTOMAKE_VERSION
# -------------------------------
# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced.
# This function is AC_REQUIREd by AM_INIT_AUTOMAKE.
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
[AM_AUTOMAKE_VERSION([1.14.1])dnl
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))])
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
# $ac_aux_dir to '$srcdir/foo'. In other projects, it is set to
# '$srcdir', '$srcdir/..', or '$srcdir/../..'.
#
# Of course, Automake must honor this variable whenever it calls a
# tool from the auxiliary directory. The problem is that $srcdir (and
# therefore $ac_aux_dir as well) can be either absolute or relative,
# depending on how configure is run. This is pretty annoying, since
# it makes $ac_aux_dir quite unusable in subdirectories: in the top
# source directory, any form will work fine, but in subdirectories a
# relative path needs to be adjusted first.
#
# $ac_aux_dir/missing
# fails when called from a subdirectory if $ac_aux_dir is relative
# $top_srcdir/$ac_aux_dir/missing
# fails if $ac_aux_dir is absolute,
# fails when called from a subdirectory in a VPATH build with
# a relative $ac_aux_dir
#
# The reason of the latter failure is that $top_srcdir and $ac_aux_dir
# are both prefixed by $srcdir. In an in-source build this is usually
# harmless because $srcdir is '.', but things will broke when you
# start a VPATH build or use an absolute $srcdir.
#
# So we could use something similar to $top_srcdir/$ac_aux_dir/missing,
# iff we strip the leading $srcdir from $ac_aux_dir. That would be:
# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"`
# and then we would define $MISSING as
# MISSING="\${SHELL} $am_aux_dir/missing"
# This will work as long as MISSING is not called from configure, because
# unfortunately $(top_srcdir) has no meaning in configure.
# However there are other variables, like CC, which are often used in
# configure, and could therefore not use this "fixed" $ac_aux_dir.
#
# Another solution, used here, is to always expand $ac_aux_dir to an
# absolute PATH. The drawback is that using absolute paths prevent a
# configured tree to be moved without reconfiguration.
AC_DEFUN([AM_AUX_DIR_EXPAND],
[dnl Rely on autoconf to set up CDPATH properly.
AC_PREREQ([2.50])dnl
# expand $ac_aux_dir to an absolute path
am_aux_dir=`cd $ac_aux_dir && pwd`
])
# AM_CONDITIONAL -*- Autoconf -*-
# Copyright (C) 1997-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_CONDITIONAL(NAME, SHELL-CONDITION)
# -------------------------------------
# Define a conditional.
AC_DEFUN([AM_CONDITIONAL],
[AC_PREREQ([2.52])dnl
m4_if([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])],
[$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl
AC_SUBST([$1_TRUE])dnl
AC_SUBST([$1_FALSE])dnl
_AM_SUBST_NOTMAKE([$1_TRUE])dnl
_AM_SUBST_NOTMAKE([$1_FALSE])dnl
m4_define([_AM_COND_VALUE_$1], [$2])dnl
if $2; then
$1_TRUE=
$1_FALSE='#'
else
$1_TRUE='#'
$1_FALSE=
fi
AC_CONFIG_COMMANDS_PRE(
[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then
AC_MSG_ERROR([[conditional "$1" was never defined.
Usually this means the macro was only invoked conditionally.]])
fi])])
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# There are a few dirty hacks below to avoid letting 'AC_PROG_CC' be
# written in clear, in which case automake, when reading aclocal.m4,
# will think it sees a *use*, and therefore will trigger all it's
# C support machinery. Also note that it means that autoscan, seeing
# CC etc. in the Makefile, will ask for an AC_PROG_CC use...
# _AM_DEPENDENCIES(NAME)
# ----------------------
# See how the compiler implements dependency checking.
# NAME is "CC", "CXX", "OBJC", "OBJCXX", "UPC", or "GJC".
# We try a few techniques and use that to set a single cache variable.
#
# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was
# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular
# dependency, and given that the user is not expected to run this macro,
# just rely on AC_PROG_CC.
AC_DEFUN([_AM_DEPENDENCIES],
[AC_REQUIRE([AM_SET_DEPDIR])dnl
AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl
AC_REQUIRE([AM_MAKE_INCLUDE])dnl
AC_REQUIRE([AM_DEP_TRACK])dnl
m4_if([$1], [CC], [depcc="$CC" am_compiler_list=],
[$1], [CXX], [depcc="$CXX" am_compiler_list=],
[$1], [OBJC], [depcc="$OBJC" am_compiler_list='gcc3 gcc'],
[$1], [OBJCXX], [depcc="$OBJCXX" am_compiler_list='gcc3 gcc'],
[$1], [UPC], [depcc="$UPC" am_compiler_list=],
[$1], [GCJ], [depcc="$GCJ" am_compiler_list='gcc3 gcc'],
[depcc="$$1" am_compiler_list=])
AC_CACHE_CHECK([dependency style of $depcc],
[am_cv_$1_dependencies_compiler_type],
[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
# We make a subdir and do the tests there. Otherwise we can end up
# making bogus files that we don't know about and never remove. For
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named 'D' -- because '-MD' means "put the output
# in D".
rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
cp "$am_depcomp" conftest.dir
cd conftest.dir
# We will build objects and dependencies in a subdirectory because
# it helps to detect inapplicable dependency modes. For instance
# both Tru64's cc and ICC support -MD to output dependencies as a
# side effect of compilation, but ICC will put the dependencies in
# the current directory while Tru64 will put them in the object
# directory.
mkdir sub
am_cv_$1_dependencies_compiler_type=none
if test "$am_compiler_list" = ""; then
am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp`
fi
am__universal=false
m4_case([$1], [CC],
[case " $depcc " in #(
*\ -arch\ *\ -arch\ *) am__universal=true ;;
esac],
[CXX],
[case " $depcc " in #(
*\ -arch\ *\ -arch\ *) am__universal=true ;;
esac])
for depmode in $am_compiler_list; do
# Setup a source with many dependencies, because some compilers
# like to wrap large dependency lists on column 80 (with \), and
# we should not choose a depcomp mode which is confused by this.
#
# We need to recreate these files for each test, as the compiler may
# overwrite some of them when testing with obscure command lines.
# This happens at least with the AIX C compiler.
: > sub/conftest.c
for i in 1 2 3 4 5 6; do
echo '#include "conftst'$i'.h"' >> sub/conftest.c
# Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
# Solaris 10 /bin/sh.
echo '/* dummy */' > sub/conftst$i.h
done
echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
# We check with '-c' and '-o' for the sake of the "dashmstdout"
# mode. It turns out that the SunPro C++ compiler does not properly
# handle '-M -o', and we need to detect this. Also, some Intel
# versions had trouble with output in subdirs.
am__obj=sub/conftest.${OBJEXT-o}
am__minus_obj="-o $am__obj"
case $depmode in
gcc)
# This depmode causes a compiler race in universal mode.
test "$am__universal" = false || continue
;;
nosideeffect)
# After this tag, mechanisms are not by side-effect, so they'll
# only be used when explicitly requested.
if test "x$enable_dependency_tracking" = xyes; then
continue
else
break
fi
;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys)
# This compiler won't grok '-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
am__obj=conftest.${OBJEXT-o}
am__minus_obj=
;;
none) break ;;
esac
if depmode=$depmode \
source=sub/conftest.c object=$am__obj \
depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
$SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
>/dev/null 2>conftest.err &&
grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
${MAKE-make} -s -f confmf > /dev/null 2>&1; then
# icc doesn't choke on unknown options, it will just issue warnings
# or remarks (even with -Werror). So we grep stderr for any message
# that says an option was ignored or not supported.
# When given -MP, icc 7.0 and 7.1 complain thusly:
# icc: Command line warning: ignoring option '-M'; no argument required
# The diagnosis changed in icc 8.0:
# icc: Command line remark: option '-MP' not supported
if (grep 'ignoring option' conftest.err ||
grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
am_cv_$1_dependencies_compiler_type=$depmode
break
fi
fi
done
cd ..
rm -rf conftest.dir
else
am_cv_$1_dependencies_compiler_type=none
fi
])
AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type])
AM_CONDITIONAL([am__fastdep$1], [
test "x$enable_dependency_tracking" != xno \
&& test "$am_cv_$1_dependencies_compiler_type" = gcc3])
])
# AM_SET_DEPDIR
# -------------
# Choose a directory name for dependency files.
# This macro is AC_REQUIREd in _AM_DEPENDENCIES.
AC_DEFUN([AM_SET_DEPDIR],
[AC_REQUIRE([AM_SET_LEADING_DOT])dnl
AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl
])
# AM_DEP_TRACK
# ------------
AC_DEFUN([AM_DEP_TRACK],
[AC_ARG_ENABLE([dependency-tracking], [dnl
AS_HELP_STRING(
[--enable-dependency-tracking],
[do not reject slow dependency extractors])
AS_HELP_STRING(
[--disable-dependency-tracking],
[speeds up one-time build])])
if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\'
am__nodep='_no'
fi
AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno])
AC_SUBST([AMDEPBACKSLASH])dnl
_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl
AC_SUBST([am__nodep])dnl
_AM_SUBST_NOTMAKE([am__nodep])dnl
])
# Generate code to set up dependency tracking. -*- Autoconf -*-
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_OUTPUT_DEPENDENCY_COMMANDS
# ------------------------------
AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS],
[{
# Older Autoconf quotes --file arguments for eval, but not when files
# are listed without --file. Let's play safe and only enable the eval
# if we detect the quoting.
case $CONFIG_FILES in
*\'*) eval set x "$CONFIG_FILES" ;;
*) set x $CONFIG_FILES ;;
esac
shift
for mf
do
# Strip MF so we end up with the name of the file.
mf=`echo "$mf" | sed -e 's/:.*$//'`
# Check whether this is an Automake generated Makefile or not.
# We used to match only the files named 'Makefile.in', but
# some people rename them; so instead we look at the file content.
# Grep'ing the first line is not enough: some people post-process
# each Makefile.in and add a new line on top of each file to say so.
# Grep'ing the whole file is not good either: AIX grep has a line
# limit of 2048, but all sed's we know have understand at least 4000.
if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then
dirpart=`AS_DIRNAME("$mf")`
else
continue
fi
# Extract the definition of DEPDIR, am__include, and am__quote
# from the Makefile without running 'make'.
DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"`
test -z "$DEPDIR" && continue
am__include=`sed -n 's/^am__include = //p' < "$mf"`
test -z "$am__include" && continue
am__quote=`sed -n 's/^am__quote = //p' < "$mf"`
# Find all dependency output files, they are included files with
# $(DEPDIR) in their names. We invoke sed twice because it is the
# simplest approach to changing $(DEPDIR) to its actual value in the
# expansion.
for file in `sed -n "
s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \
sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do
# Make sure the directory exists.
test -f "$dirpart/$file" && continue
fdir=`AS_DIRNAME(["$file"])`
AS_MKDIR_P([$dirpart/$fdir])
# echo "creating $dirpart/$file"
echo '# dummy' > "$dirpart/$file"
done
done
}
])# _AM_OUTPUT_DEPENDENCY_COMMANDS
# AM_OUTPUT_DEPENDENCY_COMMANDS
# -----------------------------
# This macro should only be invoked once -- use via AC_REQUIRE.
#
# This code is only required when automatic dependency tracking
# is enabled. FIXME. This creates each '.P' file that we will
# need in order to bootstrap the dependency handling code.
AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS],
[AC_CONFIG_COMMANDS([depfiles],
[test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS],
[AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"])
])
# Do all the work for Automake. -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This macro actually does too much. Some checks are only needed if
# your package does certain things. But this isn't really a big deal.
dnl Redefine AC_PROG_CC to automatically invoke _AM_PROG_CC_C_O.
m4_define([AC_PROG_CC],
m4_defn([AC_PROG_CC])
[_AM_PROG_CC_C_O
])
# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
# AM_INIT_AUTOMAKE([OPTIONS])
# -----------------------------------------------
# The call with PACKAGE and VERSION arguments is the old style
# call (pre autoconf-2.50), which is being phased out. PACKAGE
# and VERSION should now be passed to AC_INIT and removed from
# the call to AM_INIT_AUTOMAKE.
# We support both call styles for the transition. After
# the next Automake release, Autoconf can make the AC_INIT
# arguments mandatory, and then we can depend on a new Autoconf
# release and drop the old call support.
AC_DEFUN([AM_INIT_AUTOMAKE],
[AC_PREREQ([2.65])dnl
dnl Autoconf wants to disallow AM_ names. We explicitly allow
dnl the ones we care about.
m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl
AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl
AC_REQUIRE([AC_PROG_INSTALL])dnl
if test "`cd $srcdir && pwd`" != "`pwd`"; then
# Use -I$(srcdir) only when $(srcdir) != ., so that make's output
# is not polluted with repeated "-I."
AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl
# test to see if srcdir already configured
if test -f $srcdir/config.status; then
AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
fi
fi
# test whether we have cygpath
if test -z "$CYGPATH_W"; then
if (cygpath --version) >/dev/null 2>/dev/null; then
CYGPATH_W='cygpath -w'
else
CYGPATH_W=echo
fi
fi
AC_SUBST([CYGPATH_W])
# Define the identity of the package.
dnl Distinguish between old-style and new-style calls.
m4_ifval([$2],
[AC_DIAGNOSE([obsolete],
[$0: two- and three-arguments forms are deprecated.])
m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl
AC_SUBST([PACKAGE], [$1])dnl
AC_SUBST([VERSION], [$2])],
[_AM_SET_OPTIONS([$1])dnl
dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT.
m4_if(
m4_ifdef([AC_PACKAGE_NAME], [ok]):m4_ifdef([AC_PACKAGE_VERSION], [ok]),
[ok:ok],,
[m4_fatal([AC_INIT should be called with package and version arguments])])dnl
AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl
AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl
_AM_IF_OPTION([no-define],,
[AC_DEFINE_UNQUOTED([PACKAGE], ["$PACKAGE"], [Name of package])
AC_DEFINE_UNQUOTED([VERSION], ["$VERSION"], [Version number of package])])dnl
# Some tools Automake needs.
AC_REQUIRE([AM_SANITY_CHECK])dnl
AC_REQUIRE([AC_ARG_PROGRAM])dnl
AM_MISSING_PROG([ACLOCAL], [aclocal-${am__api_version}])
AM_MISSING_PROG([AUTOCONF], [autoconf])
AM_MISSING_PROG([AUTOMAKE], [automake-${am__api_version}])
AM_MISSING_PROG([AUTOHEADER], [autoheader])
AM_MISSING_PROG([MAKEINFO], [makeinfo])
AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl
AC_REQUIRE([AC_PROG_MKDIR_P])dnl
# For better backward compatibility. To be removed once Automake 1.9.x
# dies out for good. For more background, see:
#
#
AC_SUBST([mkdir_p], ['$(MKDIR_P)'])
# We need awk for the "check" target. The system "awk" is bad on
# some platforms.
AC_REQUIRE([AC_PROG_AWK])dnl
AC_REQUIRE([AC_PROG_MAKE_SET])dnl
AC_REQUIRE([AM_SET_LEADING_DOT])dnl
_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])],
[_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])],
[_AM_PROG_TAR([v7])])])
_AM_IF_OPTION([no-dependencies],,
[AC_PROVIDE_IFELSE([AC_PROG_CC],
[_AM_DEPENDENCIES([CC])],
[m4_define([AC_PROG_CC],
m4_defn([AC_PROG_CC])[_AM_DEPENDENCIES([CC])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_CXX],
[_AM_DEPENDENCIES([CXX])],
[m4_define([AC_PROG_CXX],
m4_defn([AC_PROG_CXX])[_AM_DEPENDENCIES([CXX])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_OBJC],
[_AM_DEPENDENCIES([OBJC])],
[m4_define([AC_PROG_OBJC],
m4_defn([AC_PROG_OBJC])[_AM_DEPENDENCIES([OBJC])])])dnl
AC_PROVIDE_IFELSE([AC_PROG_OBJCXX],
[_AM_DEPENDENCIES([OBJCXX])],
[m4_define([AC_PROG_OBJCXX],
m4_defn([AC_PROG_OBJCXX])[_AM_DEPENDENCIES([OBJCXX])])])dnl
])
AC_REQUIRE([AM_SILENT_RULES])dnl
dnl The testsuite driver may need to know about EXEEXT, so add the
dnl 'am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This
dnl macro is hooked onto _AC_COMPILER_EXEEXT early, see below.
AC_CONFIG_COMMANDS_PRE(dnl
[m4_provide_if([_AM_COMPILER_EXEEXT],
[AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl
# POSIX will say in a future version that running "rm -f" with no argument
# is OK; and we want to be able to make that assumption in our Makefile
# recipes. So use an aggressive probe to check that the usage we want is
# actually supported "in the wild" to an acceptable degree.
# See automake bug#10828.
# To make any issue more visible, cause the running configure to be aborted
# by default if the 'rm' program in use doesn't match our expectations; the
# user can still override this though.
if rm -f && rm -fr && rm -rf; then : OK; else
cat >&2 <<'END'
Oops!
Your 'rm' program seems unable to run without file operands specified
on the command line, even when the '-f' option is present. This is contrary
to the behaviour of most rm programs out there, and not conforming with
the upcoming POSIX standard:
Please tell bug-automake@gnu.org about your system, including the value
of your $PATH and any error possibly output before this message. This
can help us improve future automake versions.
END
if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then
echo 'Configuration will proceed anyway, since you have set the' >&2
echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2
echo >&2
else
cat >&2 <<'END'
Aborting the configuration process, to ensure you take notice of the issue.
You can download and install GNU coreutils to get an 'rm' implementation
that behaves properly: .
If you want to complete the configuration process using your problematic
'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM
to "yes", and re-run configure.
END
AC_MSG_ERROR([Your 'rm' program is bad, sorry.])
fi
fi])
dnl Hook into '_AC_COMPILER_EXEEXT' early to learn its expansion. Do not
dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further
dnl mangled by Autoconf and run in a shell conditional statement.
m4_define([_AC_COMPILER_EXEEXT],
m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])])
# When config.status generates a header, we must update the stamp-h file.
# This file resides in the same directory as the config header
# that is generated. The stamp files are numbered to have different names.
# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the
# loop where config.status creates the headers, so we can generate
# our stamp files there.
AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK],
[# Compute $1's index in $config_headers.
_am_arg=$1
_am_stamp_count=1
for _am_header in $config_headers :; do
case $_am_header in
$_am_arg | $_am_arg:* )
break ;;
* )
_am_stamp_count=`expr $_am_stamp_count + 1` ;;
esac
done
echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_PROG_INSTALL_SH
# ------------------
# Define $install_sh.
AC_DEFUN([AM_PROG_INSTALL_SH],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
if test x"${install_sh}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;;
*)
install_sh="\${SHELL} $am_aux_dir/install-sh"
esac
fi
AC_SUBST([install_sh])])
# Copyright (C) 2003-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# Check whether the underlying file-system supports filenames
# with a leading dot. For instance MS-DOS doesn't.
AC_DEFUN([AM_SET_LEADING_DOT],
[rm -rf .tst 2>/dev/null
mkdir .tst 2>/dev/null
if test -d .tst; then
am__leading_dot=.
else
am__leading_dot=_
fi
rmdir .tst 2>/dev/null
AC_SUBST([am__leading_dot])])
# Add --enable-maintainer-mode option to configure. -*- Autoconf -*-
# From Jim Meyering
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MAINTAINER_MODE([DEFAULT-MODE])
# ----------------------------------
# Control maintainer-specific portions of Makefiles.
# Default is to disable them, unless 'enable' is passed literally.
# For symmetry, 'disable' may be passed as well. Anyway, the user
# can override the default with the --enable/--disable switch.
AC_DEFUN([AM_MAINTAINER_MODE],
[m4_case(m4_default([$1], [disable]),
[enable], [m4_define([am_maintainer_other], [disable])],
[disable], [m4_define([am_maintainer_other], [enable])],
[m4_define([am_maintainer_other], [enable])
m4_warn([syntax], [unexpected argument to AM@&t@_MAINTAINER_MODE: $1])])
AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
dnl maintainer-mode's default is 'disable' unless 'enable' is passed
AC_ARG_ENABLE([maintainer-mode],
[AS_HELP_STRING([--]am_maintainer_other[-maintainer-mode],
am_maintainer_other[ make rules and dependencies not useful
(and sometimes confusing) to the casual installer])],
[USE_MAINTAINER_MODE=$enableval],
[USE_MAINTAINER_MODE=]m4_if(am_maintainer_other, [enable], [no], [yes]))
AC_MSG_RESULT([$USE_MAINTAINER_MODE])
AM_CONDITIONAL([MAINTAINER_MODE], [test $USE_MAINTAINER_MODE = yes])
MAINT=$MAINTAINER_MODE_TRUE
AC_SUBST([MAINT])dnl
]
)
# Check to see how 'make' treats includes. -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MAKE_INCLUDE()
# -----------------
# Check to see how make treats includes.
AC_DEFUN([AM_MAKE_INCLUDE],
[am_make=${MAKE-make}
cat > confinc << 'END'
am__doit:
@echo this is the am__doit target
.PHONY: am__doit
END
# If we don't find an include directive, just comment out the code.
AC_MSG_CHECKING([for style of include used by $am_make])
am__include="#"
am__quote=
_am_result=none
# First try GNU make style include.
echo "include confinc" > confmf
# Ignore all kinds of additional output from 'make'.
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=include
am__quote=
_am_result=GNU
;;
esac
# Now try BSD make style include.
if test "$am__include" = "#"; then
echo '.include "confinc"' > confmf
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=.include
am__quote="\""
_am_result=BSD
;;
esac
fi
AC_SUBST([am__include])
AC_SUBST([am__quote])
AC_MSG_RESULT([$_am_result])
rm -f confinc confmf
])
# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*-
# Copyright (C) 1997-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_MISSING_PROG(NAME, PROGRAM)
# ------------------------------
AC_DEFUN([AM_MISSING_PROG],
[AC_REQUIRE([AM_MISSING_HAS_RUN])
$1=${$1-"${am_missing_run}$2"}
AC_SUBST($1)])
# AM_MISSING_HAS_RUN
# ------------------
# Define MISSING if not defined so far and test if it is modern enough.
# If it is, set am_missing_run to use it, otherwise, to nothing.
AC_DEFUN([AM_MISSING_HAS_RUN],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
AC_REQUIRE_AUX_FILE([missing])dnl
if test x"${MISSING+set}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;;
*)
MISSING="\${SHELL} $am_aux_dir/missing" ;;
esac
fi
# Use eval to expand $SHELL
if eval "$MISSING --is-lightweight"; then
am_missing_run="$MISSING "
else
am_missing_run=
AC_MSG_WARN(['missing' script is too old or missing])
fi
])
# Helper functions for option handling. -*- Autoconf -*-
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_MANGLE_OPTION(NAME)
# -----------------------
AC_DEFUN([_AM_MANGLE_OPTION],
[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])])
# _AM_SET_OPTION(NAME)
# --------------------
# Set option NAME. Presently that only means defining a flag for this option.
AC_DEFUN([_AM_SET_OPTION],
[m4_define(_AM_MANGLE_OPTION([$1]), [1])])
# _AM_SET_OPTIONS(OPTIONS)
# ------------------------
# OPTIONS is a space-separated list of Automake options.
AC_DEFUN([_AM_SET_OPTIONS],
[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])])
# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET])
# -------------------------------------------
# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise.
AC_DEFUN([_AM_IF_OPTION],
[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
# Copyright (C) 1999-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_PROG_CC_C_O
# ---------------
# Like AC_PROG_CC_C_O, but changed for automake. We rewrite AC_PROG_CC
# to automatically call this.
AC_DEFUN([_AM_PROG_CC_C_O],
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
AC_REQUIRE_AUX_FILE([compile])dnl
AC_LANG_PUSH([C])dnl
AC_CACHE_CHECK(
[whether $CC understands -c and -o together],
[am_cv_prog_cc_c_o],
[AC_LANG_CONFTEST([AC_LANG_PROGRAM([])])
# Make sure it works both with $CC and with simple cc.
# Following AC_PROG_CC_C_O, we do the test twice because some
# compilers refuse to overwrite an existing .o file with -o,
# though they will create one.
am_cv_prog_cc_c_o=yes
for am_i in 1 2; do
if AM_RUN_LOG([$CC -c conftest.$ac_ext -o conftest2.$ac_objext]) \
&& test -f conftest2.$ac_objext; then
: OK
else
am_cv_prog_cc_c_o=no
break
fi
done
rm -f core conftest*
unset am_i])
if test "$am_cv_prog_cc_c_o" != yes; then
# Losing compiler, so override with the script.
# FIXME: It is wrong to rewrite CC.
# But if we don't then we get into trouble of one sort or another.
# A longer-term fix would be to have automake use am__CC in this case,
# and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
CC="$am_aux_dir/compile $CC"
fi
AC_LANG_POP([C])])
# For backward compatibility.
AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_RUN_LOG(COMMAND)
# -------------------
# Run COMMAND, save the exit status in ac_status, and log it.
# (This has been adapted from Autoconf's _AC_RUN_LOG macro.)
AC_DEFUN([AM_RUN_LOG],
[{ echo "$as_me:$LINENO: $1" >&AS_MESSAGE_LOG_FD
($1) >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD
(exit $ac_status); }])
# Check to make sure that the build environment is sane. -*- Autoconf -*-
# Copyright (C) 1996-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_SANITY_CHECK
# ---------------
AC_DEFUN([AM_SANITY_CHECK],
[AC_MSG_CHECKING([whether build environment is sane])
# Reject unsafe characters in $srcdir or the absolute working directory
# name. Accept space and tab only in the latter.
am_lf='
'
case `pwd` in
*[[\\\"\#\$\&\'\`$am_lf]]*)
AC_MSG_ERROR([unsafe absolute working directory name]);;
esac
case $srcdir in
*[[\\\"\#\$\&\'\`$am_lf\ \ ]]*)
AC_MSG_ERROR([unsafe srcdir value: '$srcdir']);;
esac
# Do 'set' in a subshell so we don't clobber the current shell's
# arguments. Must try -L first in case configure is actually a
# symlink; some systems play weird games with the mod time of symlinks
# (eg FreeBSD returns the mod time of the symlink's containing
# directory).
if (
am_has_slept=no
for am_try in 1 2; do
echo "timestamp, slept: $am_has_slept" > conftest.file
set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
if test "$[*]" = "X"; then
# -L didn't work.
set X `ls -t "$srcdir/configure" conftest.file`
fi
if test "$[*]" != "X $srcdir/configure conftest.file" \
&& test "$[*]" != "X conftest.file $srcdir/configure"; then
# If neither matched, then we have a broken ls. This can happen
# if, for instance, CONFIG_SHELL is bash and it inherits a
# broken ls alias from the environment. This has actually
# happened. Such a system could not be considered "sane".
AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken
alias in your environment])
fi
if test "$[2]" = conftest.file || test $am_try -eq 2; then
break
fi
# Just in case.
sleep 1
am_has_slept=yes
done
test "$[2]" = conftest.file
)
then
# Ok.
:
else
AC_MSG_ERROR([newly created file is older than distributed files!
Check your system clock])
fi
AC_MSG_RESULT([yes])
# If we didn't sleep, we still need to ensure time stamps of config.status and
# generated files are strictly newer.
am_sleep_pid=
if grep 'slept: no' conftest.file >/dev/null 2>&1; then
( sleep 1 ) &
am_sleep_pid=$!
fi
AC_CONFIG_COMMANDS_PRE(
[AC_MSG_CHECKING([that generated files are newer than configure])
if test -n "$am_sleep_pid"; then
# Hide warnings about reused PIDs.
wait $am_sleep_pid 2>/dev/null
fi
AC_MSG_RESULT([done])])
rm -f conftest.file
])
# Copyright (C) 2009-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_SILENT_RULES([DEFAULT])
# --------------------------
# Enable less verbose build rules; with the default set to DEFAULT
# ("yes" being less verbose, "no" or empty being verbose).
AC_DEFUN([AM_SILENT_RULES],
[AC_ARG_ENABLE([silent-rules], [dnl
AS_HELP_STRING(
[--enable-silent-rules],
[less verbose build output (undo: "make V=1")])
AS_HELP_STRING(
[--disable-silent-rules],
[verbose build output (undo: "make V=0")])dnl
])
case $enable_silent_rules in @%:@ (((
yes) AM_DEFAULT_VERBOSITY=0;;
no) AM_DEFAULT_VERBOSITY=1;;
*) AM_DEFAULT_VERBOSITY=m4_if([$1], [yes], [0], [1]);;
esac
dnl
dnl A few 'make' implementations (e.g., NonStop OS and NextStep)
dnl do not support nested variable expansions.
dnl See automake bug#9928 and bug#10237.
am_make=${MAKE-make}
AC_CACHE_CHECK([whether $am_make supports nested variables],
[am_cv_make_support_nested_variables],
[if AS_ECHO([['TRUE=$(BAR$(V))
BAR0=false
BAR1=true
V=1
am__doit:
@$(TRUE)
.PHONY: am__doit']]) | $am_make -f - >/dev/null 2>&1; then
am_cv_make_support_nested_variables=yes
else
am_cv_make_support_nested_variables=no
fi])
if test $am_cv_make_support_nested_variables = yes; then
dnl Using '$V' instead of '$(V)' breaks IRIX make.
AM_V='$(V)'
AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
else
AM_V=$AM_DEFAULT_VERBOSITY
AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY
fi
AC_SUBST([AM_V])dnl
AM_SUBST_NOTMAKE([AM_V])dnl
AC_SUBST([AM_DEFAULT_V])dnl
AM_SUBST_NOTMAKE([AM_DEFAULT_V])dnl
AC_SUBST([AM_DEFAULT_VERBOSITY])dnl
AM_BACKSLASH='\'
AC_SUBST([AM_BACKSLASH])dnl
_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl
])
# Copyright (C) 2001-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# AM_PROG_INSTALL_STRIP
# ---------------------
# One issue with vendor 'install' (even GNU) is that you can't
# specify the program used to strip binaries. This is especially
# annoying in cross-compiling environments, where the build's strip
# is unlikely to handle the host's binaries.
# Fortunately install-sh will honor a STRIPPROG variable, so we
# always use install-sh in "make install-strip", and initialize
# STRIPPROG with the value of the STRIP variable (set by the user).
AC_DEFUN([AM_PROG_INSTALL_STRIP],
[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl
# Installed binaries are usually stripped using 'strip' when the user
# run "make install-strip". However 'strip' might not be the right
# tool to use in cross-compilation environments, therefore Automake
# will honor the 'STRIP' environment variable to overrule this program.
dnl Don't test for $cross_compiling = yes, because it might be 'maybe'.
if test "$cross_compiling" != no; then
AC_CHECK_TOOL([STRIP], [strip], :)
fi
INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
AC_SUBST([INSTALL_STRIP_PROGRAM])])
# Copyright (C) 2006-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_SUBST_NOTMAKE(VARIABLE)
# ---------------------------
# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in.
# This macro is traced by Automake.
AC_DEFUN([_AM_SUBST_NOTMAKE])
# AM_SUBST_NOTMAKE(VARIABLE)
# --------------------------
# Public sister of _AM_SUBST_NOTMAKE.
AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)])
# Check how to create a tarball. -*- Autoconf -*-
# Copyright (C) 2004-2013 Free Software Foundation, Inc.
#
# This file is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# _AM_PROG_TAR(FORMAT)
# --------------------
# Check how to create a tarball in format FORMAT.
# FORMAT should be one of 'v7', 'ustar', or 'pax'.
#
# Substitute a variable $(am__tar) that is a command
# writing to stdout a FORMAT-tarball containing the directory
# $tardir.
# tardir=directory && $(am__tar) > result.tar
#
# Substitute a variable $(am__untar) that extract such
# a tarball read from stdin.
# $(am__untar) < result.tar
#
AC_DEFUN([_AM_PROG_TAR],
[# Always define AMTAR for backward compatibility. Yes, it's still used
# in the wild :-( We should find a proper way to deprecate it ...
AC_SUBST([AMTAR], ['$${TAR-tar}'])
# We'll loop over all known methods to create a tar archive until one works.
_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none'
m4_if([$1], [v7],
[am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'],
[m4_case([$1],
[ustar],
[# The POSIX 1988 'ustar' format is defined with fixed-size fields.
# There is notably a 21 bits limit for the UID and the GID. In fact,
# the 'pax' utility can hang on bigger UID/GID (see automake bug#8343
# and bug#13588).
am_max_uid=2097151 # 2^21 - 1
am_max_gid=$am_max_uid
# The $UID and $GID variables are not portable, so we need to resort
# to the POSIX-mandated id(1) utility. Errors in the 'id' calls
# below are definitely unexpected, so allow the users to see them
# (that is, avoid stderr redirection).
am_uid=`id -u || echo unknown`
am_gid=`id -g || echo unknown`
AC_MSG_CHECKING([whether UID '$am_uid' is supported by ustar format])
if test $am_uid -le $am_max_uid; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
_am_tools=none
fi
AC_MSG_CHECKING([whether GID '$am_gid' is supported by ustar format])
if test $am_gid -le $am_max_gid; then
AC_MSG_RESULT([yes])
else
AC_MSG_RESULT([no])
_am_tools=none
fi],
[pax],
[],
[m4_fatal([Unknown tar format])])
AC_MSG_CHECKING([how to create a $1 tar archive])
# Go ahead even if we have the value already cached. We do so because we
# need to set the values for the 'am__tar' and 'am__untar' variables.
_am_tools=${am_cv_prog_tar_$1-$_am_tools}
for _am_tool in $_am_tools; do
case $_am_tool in
gnutar)
for _am_tar in tar gnutar gtar; do
AM_RUN_LOG([$_am_tar --version]) && break
done
am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"'
am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"'
am__untar="$_am_tar -xf -"
;;
plaintar)
# Must skip GNU tar: if it does not support --format= it doesn't create
# ustar tarball either.
(tar --version) >/dev/null 2>&1 && continue
am__tar='tar chf - "$$tardir"'
am__tar_='tar chf - "$tardir"'
am__untar='tar xf -'
;;
pax)
am__tar='pax -L -x $1 -w "$$tardir"'
am__tar_='pax -L -x $1 -w "$tardir"'
am__untar='pax -r'
;;
cpio)
am__tar='find "$$tardir" -print | cpio -o -H $1 -L'
am__tar_='find "$tardir" -print | cpio -o -H $1 -L'
am__untar='cpio -i -H $1 -d'
;;
none)
am__tar=false
am__tar_=false
am__untar=false
;;
esac
# If the value was cached, stop now. We just wanted to have am__tar
# and am__untar set.
test -n "${am_cv_prog_tar_$1}" && break
# tar/untar a dummy directory, and stop if the command works.
rm -rf conftest.dir
mkdir conftest.dir
echo GrepMe > conftest.dir/file
AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar])
rm -rf conftest.dir
if test -s conftest.tar; then
AM_RUN_LOG([$am__untar /dev/null 2>&1 && break
fi
done
rm -rf conftest.dir
AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool])
AC_MSG_RESULT([$am_cv_prog_tar_$1])])
AC_SUBST([am__tar])
AC_SUBST([am__untar])
]) # _AM_PROG_TAR
m4_include([m4/ax_blas.m4])
m4_include([m4/ax_lapack.m4])
m4_include([m4/ax_mpi.m4])
m4_include([m4/libtool.m4])
m4_include([m4/ltoptions.m4])
m4_include([m4/ltsugar.m4])
m4_include([m4/ltversion.m4])
m4_include([m4/lt~obsolete.m4])
arpack-ng-3.1.5/PARPACK/ 0000755 0001750 0001750 00000000000 12277671743 011465 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/SRC/ 0000755 0001750 0001750 00000000000 12277671743 012114 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/SRC/Makefile.am 0000644 0001750 0001750 00000000023 12277373057 014060 0000000 0000000 SUBDIRS = MPI BLACS arpack-ng-3.1.5/PARPACK/SRC/Makefile.in 0000644 0001750 0001750 00000043700 12277667632 014107 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/SRC
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
SOURCES =
DIST_SOURCES =
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
distdir
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = MPI BLACS
all: all-recursive
.SUFFIXES:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/SRC/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/SRC/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile
installdirs: installdirs-recursive
installdirs-am:
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-generic distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am:
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am:
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am:
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \
check-am clean clean-generic clean-libtool cscopelist-am ctags \
ctags-am distclean distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
installdirs-am maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/SRC/MPI/ 0000755 0001750 0001750 00000000000 12277671743 012541 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/SRC/MPI/psneupd.f 0000644 0001750 0001750 00000126403 12277373057 014311 0000000 0000000 c\BeginDoc
c
c\Name: psneupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PSNAUPD. PSNAUPD 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 PSNAUPD 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 PSNAUPD.
c
c\Usage:
c call psneupd
c ( COMM, RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 PSNAUPD. A further computation must be performed by the user
c to transform the Ritz values computed for OP by PSNAUPD 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 PSNAUPD. 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 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 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
c **** The remaining arguments MUST be the same as for the ****
c **** call to PSNAUPD 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 PSNEUPD following the last call
c to PSNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSNAUPD and the call to PSNEUPD.
c
c Three of these parameters (V, WORKL, INFO) are also output parameters:
c
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 PSNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+3*ncv) contains information obtained in
c PSNAUPD. They are not changed by PSNEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 PSNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine slahqr
c could not be reordered by LAPACK routine strsen.
c Re-enter subroutine psneupd 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
c the same space. Please notify the authors if this error
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 = -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 slahqr.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine strevc.
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: PSNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: PSNEUPD got a different count of the number of converged
c Ritz values than PSNAUPD got. This indicates the user
c probably made an error in passing data from PSNAUPD to
c PSNEUPD or that the data was modified before entering
c PSNEUPD.
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout Parallel ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c slahqr LAPACK routine to compute the real Schur form of an
c upper Hessenberg matrix.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK matrix initialization routine.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form.
c strsen LAPACK routine that re-orders the Schur form.
c strmm Level 3 BLAS matrix times an upper triangular matrix.
c sger Level 2 BLAS rank one update to a matrix.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 PSNAUPD 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 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 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 quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neupd.F SID: 2.3
c
c\SCCS Information:
c FILE: neupd.F SID: 1.8 DATE OF SID: 04/10/01
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine psneupd
& (comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj
logical reord
Real
& conds , rnorm, sep , temp,
& vl(1,1), temp1, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy , sger , sgeqr2, slacpy,
& slahqr, slaset, psmout, sorm2r,
& strevc, strmm , strsen, sscal ,
& psvout, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2, pslamch
external slapy2, snrm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
c | The following is used and set by PSNEUPD. |
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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values passed in from _NAUPD.')
call psvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values passed in from _NAUPD.')
call psvout (comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 psngets(comm , ishift , which ,
& nev , np , workl(irr),
& workl(iri), workl(bounds),
& workl , workl(np+1))
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values after calling _NGETS.')
call psvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values after calling _NGETS.')
call psvout (comm, logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 PSNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call psvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
call psvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call psmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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 )
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
call psvout(comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call psmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call scopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
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)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
c | * Postmultiply V by Q using sorm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | strevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
call sscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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)
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call sgemv('T' , ncv , nconv,
& one , workl(invsub), ldq ,
& workl(ihbds), 1 , zero ,
& workev , 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = slapy2(workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call psmout(comm, logfil, ncv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call scopy(nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call strmm('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PSNAUPD 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)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
do 50 k=1, ncv
temp = slapy2(workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
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
& + sigmar
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)
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)
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
call psvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
call psvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
call psvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
call psvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheigr+j-1)
else if (iconj .eq. 0) then
temp = slapy2( 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) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
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)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of PSNEUPD |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pssaup2.f 0000644 0001750 0001750 00000100702 12277373057 014222 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by pssaupd.
c
c\Usage:
c call pssaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pssaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pssaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the second column
c of H starting at H(1,2). If pssaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Real array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in pssaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c psgetv0 Parallel ARPACK initial vector generation routine.
c pssaitr Parallel ARPACK Lanczos factorization routine.
c pssapps Parallel ARPACK application of implicit shifts routine.
c ssconv ARPACK convergence of Ritz values routine.
c psseigt Parallel ARPACK compute Ritz values and error bounds routine.
c pssgets Parallel ARPACK reorder Ritz values and error bounds routine.
c ssortr ARPACK sorting routine.
c sstrqb ARPACK routine that computes all eigenvalues and the
c last component of the eigenvectors of a symmetric
c tridiagonal matrix using the implicit QL or QR method.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saup2.F SID: 2.4
c
c\SCCS Information:
c FILE: saup2.F SID: 1.5 DATE OF SID: 05/20/98
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
c
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Real
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
Real
& rnorm_buf
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, psgetv0, pssaitr, sscal, ssconv,
& psseigt, pssgets, pssapps,
& ssortr, psvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, pslamch
external sdot, psnorm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0/3.0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %---------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %---------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call psgetv0 ( comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call pssaitr (comm, ido, bmat, n, 0, nev0, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pssaitr was unable to build an Lanczos factorization|
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pssaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pssaitr was unable to build an Lanczos factorization|
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call psseigt ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call pssgets ( comm, ishift, which, nev, np, ritz,
& bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(np+1), 1)
call ssconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call psvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call ssortr (wprime, .true., kplusp, ritz, bounds)
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call ssortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call ssortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pssgets ( comm, ishift, which, nev, np,
& ritz, bounds, workl)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_saup2: NEV and NP .')
call psvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call psvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, pssgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call psvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call psvout (comm, logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After pssapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call pssapps ( comm, n, nev, np, ritz, v, ldv, h, ldh, resid,
& q, ldq, 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 pssaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call psvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call psvout (comm, logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %----------------%
c | End of pssaup2 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdneigh.f 0000644 0001750 0001750 00000025004 12277373057 014244 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdneigh
c
c Message Passing Layer: MPI
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 pdneigh
c ( COMM, RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RNORM Double precision 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 Double precision 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 RITZR, Double precision arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Double precision 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 Double precision 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 IERR Integer. (OUTPUT)
c Error exit flag from dlaqrb or dtrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dlaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices
c dvout ARPACK utility routine that prints vectors.
c dlacpy LAPACK matrix copy routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dtrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neigh.F SID: 2.2
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdneigh ( comm, rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Double precision
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dlacpy, dlaqrb, dtrevc, pdvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call pdmout (comm, 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 | dlaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call dlacpy ('All', n, n, h, ldh, workl, n)
call dlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call pdvout (comm, 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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | dtrevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = dnrm2( n, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = dlapy2( dnrm2( n, q(1,i), 1 ),
& dnrm2( n, q(1,i+1), 1 ) )
call dscal ( n, one / temp, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call pdvout (comm, logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call pdvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdznorm2.f 0000644 0001750 0001750 00000003544 12277373057 014406 0000000 0000000 c\BeginDoc
c
c\Name: pdznorm2
c
c Message Passing Layer: MPI
c
c\Description:
c
c\Usage:
c call pdznorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 3/6/96
c
c-----------------------------------------------------------------------
c
Double precision function pdznorm2 ( comm, n, x, inc )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm, ierr
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
External dznrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pdznorm2 = dznrm2( n, x, inc)
c
buf = pdznorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
pdznorm2 = zero
else
buf = (pdznorm2/max)**2.0
call MPI_ALLREDUCE( buf, pdznorm2, 1, MPI_DOUBLE_PRECISION,
& MPI_SUM, comm, ierr )
pdznorm2 = max * sqrt(abs(pdznorm2))
endif
c
c %-----------------%
c | End of pdznorm2 |
c %-----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/stat.h 0000644 0001750 0001750 00000001713 12277373057 013604 0000000 0000000 c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
c\SCCS Information: @(#)
c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
c
real t0, t1, t2, t3, t4, t5
save t0, t1, t2, t3, t4, t5
c
integer nopx, nbx, nrorth, nitref, nrstrt
real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
common /timing/
& nopx, nbx, nrorth, nitref, nrstrt,
& tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdngets.f 0000644 0001750 0001750 00000020264 12277373057 014275 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdngets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pdngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortc ARPACK sorting routine.
c dcopy Level 1 BLAS that copies one vector to another .
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ngets.F SID: 2.2
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdngets
& ( comm, ishift, which, kev, np, ritzr, ritzi,
& bounds, shiftr, shifti )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dsortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call dsortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call dsortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call dsortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine pdnapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pdvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call pdvout (comm, logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pdngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdseigt.f 0000644 0001750 0001750 00000013065 12277373057 014271 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdseigt
c
c Message Passing Layer: MPI
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call pdseigt
c ( COMM, RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RNORM Double precision scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Double precision N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Double precision array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Double precision work array of length 3*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 dstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seigt.F SID: 2.2
c
c\SCCS Information:
c FILE: seigt.F SID: 1.3 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdseigt
& ( comm, rnorm, n, h, ldh, eig, bounds, workl, ierr )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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, ldh, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dstqrb, pdvout, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call pdvout (comm, logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
c
call dcopy (n, h(1,2), 1, eig, 1)
call dcopy (n-1, h(2,1), 1, workl, 1)
call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %-----------------%
c | End of pdseigt |
c %-----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pssaitr.f 0000644 0001750 0001750 00000076605 12277373057 014330 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pssaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pssaitr
c ( COMM, IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See pssaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c psgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c psmout Parallel ARPACK utility routine that prints matrices.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saitr.F SID: 2.3
c
c\SCCS Information:
c FILE: saitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pssaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaitr
& (comm, ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Real
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
Real
& rnorm_buf
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, psgetv0, psvout, psmout,
& slascl, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, pslamch
external sdot, psnorm2, pslamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = pslamch(comm,'safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | psgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call psgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
rnorm_buf = sdot (n, resid, 1, workd(ivj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call sgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_REAL, MPI_SUM, comm, ierr)
else if (mode .eq. 2) then
call sgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_REAL, MPI_SUM, comm, ierr)
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv('N', n, j, -one, v, ldv, workl(1), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workl(j)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_REAL, MPI_SUM, comm, ierr)
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workl(j)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call sscal(n, -one, v(1,j+1), 1)
else
call sscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call psvout (comm, logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pssaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdseupd.f 0000644 0001750 0001750 00000103573 12277373057 014302 0000000 0000000 c\BeginDoc
c
c\Name: pdseupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 PSSAUPD for the linear operator OP prescribed by the MODE selection
c (see IPARAM(7) in PSSAUPD documentation.) PSSAUPD 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 PSSAUPD 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
c call pdseupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as workspace.
c
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 pdsaupd 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 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 PSSAUPD.
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 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 PDNAUPD 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 PSSEUPD following the last call
c to PSSAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSSAUPD and the call to PSSEUPD.
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(1:4*ncv) contains information obtained in
c PSSAUPD. They are not changed by PSSEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSSEUPD.
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 PSSEUPD if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 = -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: PSSAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 corresponding permutation to a matrix A.
c dsortr dsortr ARPACK sorting routine.
c pdnorm2 Parallel ARPACK routine that computes the 2-norm of a vector.
c pivout Parallel ARPACK utility routine that prints integers.
c pdvout Parallel 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 pdlamch ScaLAPACK 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 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 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
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seupd.F SID: 2.4
c
c\SCCS Information:
c FILE: seupd.F SID: 1.11 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pdseupd
& (comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
parameter (one = 1.0, zero = 0.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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Double precision
& bnorm2, rnorm, temp, temp1, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy , dger , dgeqr2, dlacpy, dorm2r, dscal,
& dsesrt, dsteqr, dswap , pdvout, pivout, dsortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdnorm2, pdlamch
external pdnorm2, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | pdsaupd 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 pdsaupd and is not |
c | modified by pdseupd. |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
c | The following is used and set by pdseupd. |
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | 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 pdseupd. |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.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 pdsaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
bnorm2 = pdnorm2(comm, n, workd, 1)
end if
c
if (msglvl .gt. 2) then
call pdvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values passed in from _SAUPD.')
call pdvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_seupd: Ritz estimates passed in from _SAUPD.')
end if
if (rvec) then
c
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(irz). Move |
c | the corresponding error estimates |
c | in workl(bound) accordingly. |
c %-------------------------------------%
c
np = ncv - nev
ishift = 0
call pdsgets(comm , ishift, which ,
& nev , np , workl(irz),
& workl(bounds), workl)
c
if (msglvl .gt. 2) then
call pdvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values after calling _SGETS.')
call pdvout(comm, logfil, ncv, workl(bounds), ndigit,
& '_seupd: Ritz value indices after calling _SGETS.')
end if
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, 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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
& '_neupd: 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 dcopy (ncv-1, workl(ih+1) , 1, workl(ihb), 1)
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
call pdvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
call pdvout (comm, logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if (.not.select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
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,
& workl(iw), 1)
call dcopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call dcopy(ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
30 end if
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call dcopy(nconv, workl(ihd), 1, d, 1)
c
else
c
c %-----------------------------------------------------%
c | Ritz vectors not required. Load Ritz values into D. |
c %-----------------------------------------------------%
c
call dcopy(nconv, workl(ritz), 1, d, 1)
call dcopy(ncv, workl(ritz), 1, workl(ihd), 1)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
c | bounds. Not necessary if only Ritz values are desired. |
c %---------------------------------------------------------%
c
if (rvec) then
call dsesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 pdsaupd. |
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)
if (type .eq. 'SHIFTI') then
do 40 k=1, ncv
workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
call dcopy (nconv, workl(ihd), 1, d, 1)
call dsortr('LA', .true., nconv, workl(ihd), workl(iw))
if (rvec) then
call dsesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy(ncv, workl(bounds), 1, workl(ihb), 1)
call dscal(ncv, bnorm2/rnorm, workl(ihb), 1)
call dsortr('LA', .true., nconv, d, workl(ihb))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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 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 %-----------------------------------------------------%
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 )
c
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 pdsaupd. |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
call pdvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
call pdvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
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)
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)
120 continue
c
end if
c
if (type .ne. 'REGULR')
& call dger(n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %----------------%
c | End of pdseupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pznaupd.f 0000644 0001750 0001750 00000067413 12277373057 014321 0000000 0000000 c\BeginDoc
c
c\Name: pznaupd
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then dsaupd or dnaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pznaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pznaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pznaupd . 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 pznaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 = pdlamch (comm, 'EPS') (machine precision as computed
c by the ScaLAPACK auxiliary subroutine pdlamch ).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below)
c
c V Complex*16 array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of pznaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by pzneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 zneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c WORKD Complex*16 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex*16 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Double precision work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 = -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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine pzneupd .
c
c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call pzneupd immediately following
c completion of pznaupd . This is new starting with release 2 of ARPACK.
c
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 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
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 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex*16 resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex*16 resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pznaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c zstatn ARPACK routine that initializes the timing variables.
c pivout Parallel ARPACK utility routine that prints integers.
c pzvout Parallel ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, rwork, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex*16
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Double precision
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pznaup2 , pzvout , pivout, arscnd, zstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call zstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0 ) tol = pdlamch (comm, 'EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine pzneigh called |
c | by pznaup2 . Subroutine pzneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pznaup2
& ( comm, 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pznaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pzvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call pzvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pznaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psnorm2.f 0000644 0001750 0001750 00000003423 12277373057 014227 0000000 0000000 c\BeginDoc
c
c\Name: psnorm2
c
c Message Passing Layer: MPI
c
c\Description:
c
c\Usage:
c call psnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 2/22/96
c
c-----------------------------------------------------------------------
c
Real function psnorm2 ( comm, n, x, inc )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm, ierr
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& snrm2
External snrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
psnorm2 = snrm2( n, x, inc)
c
buf = psnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_REAL,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
psnorm2 = zero
else
buf = (psnorm2/max)**2.0
call MPI_ALLREDUCE( buf, psnorm2, 1, MPI_REAL,
& MPI_SUM, comm, ierr )
psnorm2 = max * sqrt(abs(psnorm2))
endif
c
c %----------------%
c | End of psnorm2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/debug.h 0000644 0001750 0001750 00000001351 12277373057 013715 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcnaupd.f 0000644 0001750 0001750 00000067221 12277373057 014267 0000000 0000000 c\BeginDoc
c
c\Name: pcnaupd
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then ssaupd or snaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pcnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pcnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pcnaupd. 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 pcnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 = pslamch(comm, 'EPS') (machine precision as computed
c by the ScaLAPACK auxiliary subroutine pslamch).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below)
c
c V Complex array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of pcnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by pcneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 cneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c WORKD Complex 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Real work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 = -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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine pcneupd.
c
c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call pcneupd immediately following
c completion of pcnaupd. This is new starting with release 2 of ARPACK.
c
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 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
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 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pcnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c cstatn ARPACK routine that initializes the timing variables.
c pivout Parallel ARPACK utility routine that prints integers.
c pcvout Parallel ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, rwork, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Real
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pcnaup2, pcvout, pivout, arscnd, cstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call cstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0 ) tol = pslamch(comm, 'EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine pcneigh called |
c | by pcnaup2. Subroutine pcneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pcnaup2
& ( comm, 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pcnaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pcvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call pcvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pcnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pscnorm2.f 0000644 0001750 0001750 00000003445 12277373057 014376 0000000 0000000 c\BeginDoc
c
c\Name: pscnorm2
c
c Message Passing Layer: MPI
c
c\Description:
c
c\Usage:
c call pscnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 3/6/96
c
c-----------------------------------------------------------------------
c
Real function pscnorm2 ( comm, n, x, inc )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm, ierr
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2
External scnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pscnorm2 = scnrm2( n, x, inc)
c
buf = pscnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_REAL,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
pscnorm2 = zero
else
buf = (pscnorm2/max)**2.0
call MPI_ALLREDUCE( buf, pscnorm2, 1, MPI_REAL,
& MPI_SUM, comm, ierr )
pscnorm2 = max * sqrt(abs(pscnorm2))
endif
c
c %-----------------%
c | End of pscnorm2 |
c %-----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pzlarnv.f 0000644 0001750 0001750 00000003634 12277373057 014327 0000000 0000000 c\BeginDoc
c
c\Name: pzlarnv
c
c Message Passing Layer: MPI
c
c\Description:
c
c Parallel Version of ARPACK utility routine zlarnv
c
c PZLARNV returns a vector of n (nloc) random Complex*16 numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM MPI Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Complex*16 array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine zlarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine CLARNV to generate random
c Complex*16 numbers from a uniform or normal distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.3 DATE OF SID: 04/17/99
c
c-----------------------------------------------------------------------
c
subroutine pzlarnv( comm, idist, iseed, n, x )
c
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Complex*16
& x( * )
c ..
c .. External Subroutines ..
external zlarnv
c ..
c .. Executable Statements ..
c
call zlarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdgetv0.f 0000644 0001750 0001750 00000033535 12277373057 014207 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdgetv0
c
c Message Passing Layer: MPI
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pdgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pdgetv0 is called.
c It should be set to 1 on the initial call to pdgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Double precision N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine for vector output.
c pdlarnv Parallel wrapper for LAPACK routine dlarnv (generates a random vector).
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: getv0.F SID: 2.3
c
c\SCCS Information:
c FILE: getv0.F SID: 1.4 DATE OF SID: 3/19/97
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Double precision
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Double precision
& rnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdlarnv, pdvout, dcopy, dgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2
external ddot, pdnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pdlarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call dcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = pdnorm2( comm, n, resid, 1 )
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call dgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl, j-1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
call dgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pdvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pclarnv.f 0000644 0001750 0001750 00000003620 12277373057 014273 0000000 0000000 c\BeginDoc
c
c\Name: pclarnv
c
c Message Passing Layer: MPI
c
c\Description:
c
c Parallel Version of ARPACK utility routine clarnv
c
c PCLARNV returns a vector of n (nloc) random Complex numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM MPI Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Complex array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine clarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine CLARNV to generate random
c Complex numbers from a uniform or normal distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.3 DATE OF SID: 04/17/99
c
c-----------------------------------------------------------------------
c
subroutine pclarnv( comm, idist, iseed, n, x )
c
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Complex
& x( * )
c ..
c .. External Subroutines ..
external clarnv
c ..
c .. Executable Statements ..
c
call clarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/Makefile.am 0000644 0001750 0001750 00000001631 12277373057 014513 0000000 0000000 F77 = $(MPIF77)
noinst_LTLIBRARIES = libparpack_noopt.la libparpacksrcmpi.la
FFLAGS_SAV = @FFLAGS@
FFLAGS =
libparpack_noopt_la_SOURCES = pslamch.f pdlamch.f
libparpack_noopt_la_FFLAGS = -O0
libparpacksrcmpi_la_SOURCES = \
psgetv0.f \
psnaitr.f psnapps.f psnaup2.f psnaupd.f psneigh.f psngets.f \
pssaitr.f pssapps.f pssaup2.f pssaupd.f psseigt.f pssgets.f \
psneupd.f psseupd.f pslarnv.f psnorm2.f pdgetv0.f \
pdnaitr.f pdnapps.f pdnaup2.f pdnaupd.f pdneigh.f pdngets.f \
pdsaitr.f pdsapps.f pdsaup2.f pdsaupd.f pdseigt.f pdsgets.f \
pdneupd.f pdseupd.f pdlarnv.f pdnorm2.f \
pcnaitr.f pcnapps.f pcnaup2.f pcnaupd.f pcneigh.f \
pcneupd.f pcngets.f pcgetv0.f pscnorm2.f pclarnv.f \
pznaitr.f pznapps.f pznaup2.f pznaupd.f pzneigh.f \
pzneupd.f pzngets.f pzgetv0.f pdznorm2.f pzlarnv.f
libparpacksrcmpi_la_FFLAGS = $(FFLAGS_SAV)
libparpacksrcmpi_la_LIBADD = libparpack_noopt.la
EXTRA_DIST = debug.h stat.h arpack-ng-3.1.5/PARPACK/SRC/MPI/pdsaup2.f 0000644 0001750 0001750 00000101152 12277373057 014203 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by pdsaupd.
c
c\Usage:
c call pdsaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pdsaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pdsaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the second column
c of H starting at H(1,2). If pdsaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Double precision array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in pdsaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c pdgetv0 Parallel ARPACK initial vector generation routine.
c pdsaitr Parallel ARPACK Lanczos factorization routine.
c pdsapps Parallel ARPACK application of implicit shifts routine.
c dsconv ARPACK convergence of Ritz values routine.
c pdseigt Parallel ARPACK compute Ritz values and error bounds routine.
c pdsgets Parallel ARPACK reorder Ritz values and error bounds routine.
c dsortr ARPACK sorting routine.
c sstrqb ARPACK routine that computes all eigenvalues and the
c last component of the eigenvectors of a symmetric
c tridiagonal matrix using the implicit QL or QR method.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
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 pdnorm2 Parallel version of 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 two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saup2.F SID: 2.4
c
c\SCCS Information:
c FILE: saup2.F SID: 1.5 DATE OF SID: 05/20/98
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
c
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Double precision
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
Double precision
& rnorm_buf
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, pdgetv0, pdsaitr, dscal, dsconv,
& pdseigt, pdsgets, pdsapps,
& dsortr, pdvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, pdlamch
external ddot, pdnorm2, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0/3.0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %---------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %---------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pdgetv0 ( comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call pdsaitr (comm, ido, bmat, n, 0, nev0, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pdsaitr was unable to build an Lanczos factorization|
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pdsaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pdsaitr was unable to build an Lanczos factorization|
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call pdseigt ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call pdsgets ( comm, ishift, which, nev, np, ritz,
& bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(np+1), 1)
call dsconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call pdvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call dsortr (wprime, .true., kplusp, ritz, bounds)
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call dsortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call dsortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pdsgets ( comm, ishift, which, nev, np,
& ritz, bounds, workl)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_saup2: NEV and NP .')
call pdvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call pdvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, pdsgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call pdvout (comm, logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After pdsapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call pdsapps ( comm, n, nev, np, ritz, v, ldv, h, ldh, resid,
& q, ldq, 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 pdsaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call pdvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call pdvout (comm, logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %----------------%
c | End of pdsaup2 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pslarnv.f 0000644 0001750 0001750 00000003672 12277373057 014322 0000000 0000000 c\BeginDoc
c
c\Name: pslarnv
c
c Message Passing Layer: MPI
c
c\Description:
c
c Parallel Version of ARPACK utility routine slarnv
c
c PSLARNV returns a vector of n (nloc) random real numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM MPI Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Real array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine slarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine SLARNV to generate random
c real numbers from a uniform (0,1) distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.4 DATE OF SID: 04/16/99
c
c-----------------------------------------------------------------------
c
subroutine pslarnv( comm, idist, iseed, n, x )
c
include 'mpif.h'
c
c .. MPI VARIABLES AND FUNCTIONS ..
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Real
& x( * )
c ..
c .. External Subroutines ..
external slarnv
c ..
c .. Executable Statements ..
c
call slarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdneupd.f 0000644 0001750 0001750 00000127053 12277373057 014274 0000000 0000000 c\BeginDoc
c
c\Name: pdneupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PDNAUPD . PDNAUPD 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 PDNAUPD 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 PDNAUPD .
c
c\Usage:
c call pdneupd
c ( COMM, RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 PDNAUPD . A further computation must be performed by the user
c to transform the Ritz values computed for OP by PDNAUPD 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 PDNAUPD . 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 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 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
c **** The remaining arguments MUST be the same as for the ****
c **** call to PDNAUPD 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 PDNEUPD following the last call
c to PDNAUPD . These arguments MUST NOT BE MODIFIED between
c the the last call to PDNAUPD and the call to PDNEUPD .
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
c Upon INPUT: the NCV columns of V contain the Arnoldi basis
c vectors for OP as constructed by PDNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+3*ncv) contains information obtained in
c PDNAUPD . They are not changed by PDNEUPD .
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 pointers into WORKL for addresses
c of the above information computed by PDNEUPD .
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 PDNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
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 pdneupd 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
c the same space. Please notify the authors if this error
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 = -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 = -9: Error return from calculation of eigenvectors.
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: PDNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: PDNEUPD got a different count of the number of converged
c Ritz values than PDNAUPD got. This indicates the user
c probably made an error in passing data from PDNAUPD to
c PDNEUPD or that the data was modified before entering
c PDNEUPD .
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout Parallel 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 upper Hessenberg matrix.
c pdlamch ScaLAPACK 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 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 dnrm2 Level 1 BLAS that computes the norm of a vector.
c dscal Level 1 BLAS that scales a vector.
c dcopy Level 1 BLAS that copies one vector to another .
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 PDNAUPD 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 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 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 quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neupd.F SID: 2.3
c
c\SCCS Information:
c FILE: neupd.F SID: 1.8 DATE OF SID: 04/10/01
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pdneupd
& (comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj
logical reord
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 , pdmout , dorm2r ,
& dtrevc , dtrmm , dtrsen , dscal ,
& pdvout , pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2 , dnrm2 , pdlamch
external dlapy2 , dnrm2 , pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch (comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
c | The following is used and set by PDNEUPD . |
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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values passed in from _NAUPD.')
call pdvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values passed in from _NAUPD.')
call pdvout (comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pdngets (comm , ishift , which ,
& nev , np , workl(irr),
& workl(iri), workl(bounds),
& workl , workl(np+1))
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values after calling _NGETS.')
call pdvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values after calling _NGETS.')
call pdvout (comm, logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 PDNAUPD . |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call pdvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
call pdvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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 )
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
call pdvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
c | if a spectral transformation was not used. |
c %----------------------------------------------------%
c
if (type .eq. 'REGULR') then
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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 dlacpy ('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones |
c %---------------------------------------------------%
c
if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
call dscal (nconv, -one, workl(iuptri+j-1), ldq)
call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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 | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 )
call dscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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)
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call dgemv ('T' , ncv , nconv,
& one , workl(invsub), ldq ,
& workl(ihbds), 1 , zero ,
& workev , 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = dlapy2 (workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call dcopy (nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call dtrmm ('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PDNAUPD into DR and DI |
c %------------------------------------------------------%
c
call dcopy (nconv, workl(ritzr), 1, dr, 1)
call dcopy (nconv, workl(ritzi), 1, di, 1)
call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1)
call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1)
call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
do 50 k=1, ncv
temp = dlapy2 (workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
temp = dlapy2 (workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp
& + sigmar
workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp
& + sigmai
80 continue
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
call pdvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
call pdvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
call pdvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
call pdvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
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) )
workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigr+j-1) +
& workl(invsub+j*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call dger (n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of PDNEUPD |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psnaup2.f 0000644 0001750 0001750 00000076636 12277373057 014237 0000000 0000000 c\BeginDoc
c
c\Name: psnaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by psnaupd.
c
c\Usage:
c call psnaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in psnaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in psnaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (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 RITZR, Real arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from sneigh.
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Real 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c psgetv0 Parallel ARPACK initial vector generation routine.
c psnaitr Parallel ARPACK Arnoldi factorization routine.
c psnapps Parallel ARPACK application of implicit shifts routine.
c snconv ARPACK convergence of Ritz values routine.
c psneigh Parallel ARPACK compute Ritz values and error bounds routine.
c psngets Parallel ARPACK reorder Ritz values and error bounds routine.
c ssortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c sswap Level 1 BLAS that swaps two vectors.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Revision history:
c Starting Point: Serial Code FILE: naup2.F SID: 2.2
c
c\SCCS Information:
c FILE: naup2.F SID: 1.5 DATE OF SID: 06/01/00
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Real
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character wprime*2
logical cnorm , getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, numcnv,
& j
Real
& rnorm , temp , eps23
save cnorm , getv0, initv , update, ushift,
& rnorm , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , eps23 , numcnv
c
Real
& rnorm_buf
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, psgetv0, psnaitr, snconv,
& psneigh, psngets, psnapps,
& psvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, slapy2, pslamch
external sdot, psnorm2, slapy2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call psgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call psnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 psnapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call psnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call psneigh ( comm, rnorm, kplusp, h, ldh, ritzr, ritzi,
& bounds, q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from psneigh. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call scopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of psngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call psngets ( comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call snconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call pivout (comm, logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call psvout (comm, logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call psvout (comm, logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call svout(logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with sngets, we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in sngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call ssortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call ssortc(wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call ssortc(which, .true., nconv, ritzr, ritzi, bounds)
c
c
if (msglvl .gt. 1) then
call svout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call svout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call svout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call psngets(comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call psvout (comm, logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call psvout (comm, logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call psvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call scopy (np, workl, 1, ritzr, 1)
call scopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call psvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call psvout (comm, logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call psvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call psnapps (comm, n, nev, np, ritzr, ritzi, 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 psnaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call psmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of psnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psseupd.f 0000644 0001750 0001750 00000103417 12277373057 014316 0000000 0000000 c\BeginDoc
c
c\Name: psseupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 PSSAUPD for the linear operator OP prescribed by the MODE selection
c (see IPARAM(7) in PSSAUPD documentation.) PSSAUPD 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 PSSAUPD 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
c call psseupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as workspace.
c
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
c the Ritz values of OP computed by pssaupd 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 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.
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 PSSAUPD.
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 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 PSNAUPD 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 PSSEUPD following the last call
c to PSSAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSSAUPD and the call to PSSEUPD.
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(1:4*ncv) contains information obtained in
c PSSAUPD. They are not changed by PSSEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSSEUPD.
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 PSSEUPD if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 ssteqr.
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: PSSAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 ssesrt ARPACK routine that sorts an array X, and applies the
c corresponding permutation to a matrix A.
c ssortr ssortr ARPACK sorting routine.
c psnorm2 Parallel ARPACK routine that computes the 2-norm of a vector.
c pivout Parallel ARPACK utility routine that prints integers.
c psvout Parallel ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c pslamch ScaLAPACK routine that determines machine constants.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a tridiagonal matrix.
c sger Level 2 BLAS rank one update to a matrix.
c scopy Level 1 BLAS that copies one vector to another .
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps the contents of two vectors.
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seupd.F SID: 2.4
c
c\SCCS Information:
c FILE: seupd.F SID: 1.11 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine psseupd
& (comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
parameter (one = 1.0, zero = 0.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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Real
& bnorm2, rnorm, temp, temp1, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy , sger , sgeqr2, slacpy, sorm2r, sscal,
& ssesrt, ssteqr, sswap , psvout, pivout, ssortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& psnorm2, pslamch
external psnorm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | pssaupd 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 pssaupd and is not |
c | modified by psseupd. |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
c | The following is used and set by psseupd. |
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | ssteqr. 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 ssteqr and by psseupd. |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.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 pssaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
bnorm2 = psnorm2(comm, n, workd, 1)
end if
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values passed in from _SAUPD.')
call psvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_seupd: Ritz estimates passed in from _SAUPD.')
end if
if (rvec) then
c
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(irz). Move |
c | the corresponding error estimates |
c | in workl(bound) accordingly. |
c %-------------------------------------%
c
np = ncv - nev
ishift = 0
call pssgets(comm , ishift, which ,
& nev , np , workl(irz),
& workl(bounds), workl)
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values after calling _SGETS.')
call psvout(comm, logfil, ncv, workl(bounds), ndigit,
& '_seupd: Ritz value indices after calling _SGETS.')
end if
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, 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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
& '_neupd: 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)
c
call ssteqr('Identity', ncv , workl(ihd),
& workl(ihb), workl(iq), ldq ,
& workl(iw) , ierr)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call scopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
call psvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
call psvout (comm, logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if (.not.select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
c
temp = workl(ihd+leftptr-1)
workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
workl(ihd+rghtptr-1) = temp
call scopy(ncv, workl(iq+ncv*(leftptr-1)), 1,
& workl(iw), 1)
call scopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call scopy(ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
30 end if
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call scopy(nconv, workl(ihd), 1, d, 1)
c
else
c
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)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
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)
else
call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 pssaupd. |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c | They are only reordered. |
c %-------------------------------------------------------------%
c
call scopy (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
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
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)
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))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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)
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 %-----------------------------------------------------%
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 )
c
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 pssaupd. |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
call sscal (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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
call psvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
call psvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
call psvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
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)
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)
120 continue
c
end if
c
if (type .ne. 'REGULR')
& call sger(n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %----------------%
c | End of psseupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psneigh.f 0000644 0001750 0001750 00000024600 12277373057 014264 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psneigh
c
c Message Passing Layer: MPI
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 psneigh
c ( COMM, RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
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 Real 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 RITZR, Real arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Real 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 Real 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 IERR Integer. (OUTPUT)
c Error exit flag from slaqrb or strevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c slaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c slacpy LAPACK matrix copy routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another .
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neigh.F SID: 2.2
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psneigh ( comm, rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
Real
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Real
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, slacpy, slaqrb, strevc, psvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call psmout (comm, 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 | slaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call slacpy ('All', n, n, h, ldh, workl, n)
call slaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call psvout (comm, 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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call strevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | strevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = snrm2( n, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = slapy2( snrm2( n, q(1,i), 1 ),
& snrm2( n, q(1,i+1), 1 ) )
call sscal ( n, one / temp, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call sgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * slapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call psvout (comm, logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call psvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of psneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcnaitr.f 0000644 0001750 0001750 00000077007 12277373057 014300 0000000 0000000 c\BeginDoc
c
c\Name: pcnaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pcnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pcnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pcnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Complex work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pcgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c clanhs LAPACK routine that computes various norms of a matrix.
c clascl LAPACK routine for careful scaling of a matrix.
c slabad LAPACK routine for defining the underflow and overflow
c limits
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of
c two vectors.
c cscal Level 1 BLAS that scales a vector.
c csscal Level 1 BLAS that scales a complex vector by a real number.
c pscnorm2 Parallel version of Level 1 BLAS that computes the
c norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: naitr.F SID: 2.1
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pcnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rone, rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0, rzero = 0.0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Complex
& cnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cscal, cgemv, pcgetv0, slabad,
& csscal, pcvout, pcmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex
& cdotc
Real
& pslamch, pscnorm2, clanhs, slapy2
external cdotc, pscnorm2, clanhs, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------%
c
unfl = pslamch(comm, 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pcgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pcvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pcgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call ccopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call csscal (n, temp1, v(1,j), 1)
call csscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine clascl |
c %-----------------------------------------%
c
call clascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call clascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call ccopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call ccopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call MPI_ALLREDUCE( workl, h(1,j), j,
& MPI_COMPLEX, MPI_SUM, comm, ierr)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call psvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call pcvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_COMPLEX, MPI_SUM, comm, ierr)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call caxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pscnorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call psvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %--------------------------------------------%
c
tst1 = slapy2(real(h(i,i)),aimag(h(i,i)))
& + slapy2(real(h(i+1,i+1)), aimag(h(i+1,i+1)))
if( tst1.eq.real(zero) )
& tst1 = clanhs( '1', k+np, h, ldh, workd(n+1) )
if( slapy2(real(h(i+1,i)),aimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pcmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pcnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psngets.f 0000644 0001750 0001750 00000020204 12277373057 014306 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psngets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call psngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Real array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortc ARPACK sorting routine.
c scopy Level 1 BLAS that copies one vector to another .
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ngets.F SID: 2.2
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psngets
& ( comm, ishift, which, kev, np, ritzr, ritzi,
& bounds, shiftr, shifti )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, ssortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call ssortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call ssortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call ssortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine psnapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call ssortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call psvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call psvout (comm, logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call psvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of psngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcgetv0.f 0000644 0001750 0001750 00000034220 12277373057 014176 0000000 0000000 c\BeginDoc
c
c\Name: pcgetv0
c
c Message Passing Layer: MPI
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pcgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pcgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pcgetv0 is called.
c It should be set to 1 on the initial call to pcgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Complex work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pcvout Parallel ARPACK utility routine that prints vectors.
c pclarnv Parallel wrapper for LAPACK routine clarnv (generates a random vector).
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c ccopy Level 1 BLAS that copies one vector to another.
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: getv0.F SID: 2.1
c
c\SCCS Information:
c FILE: getv0.F SID: 1.7 DATE OF SID: 04/12/01
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) ,
& rzero = 0.0 )
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj, myid, igen
Real
& rnorm0
Complex
& cnorm, cnorm2
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Complex
& cnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, cgemv, pclarnv, pcvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pscnorm2, slapy2
Complex
& cdotc
external cdotc, pscnorm2, slapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
c
c %-----------------------------------%
c | Generate a seed on each processor |
c | using process id (myid). |
c | Note: the seed must be between 1 |
c | and 4095. iseed(4) must be odd. |
c %-----------------------------------%
c
call MPI_COMM_RANK(comm, myid, ierr)
igen = 1000 + 2*myid + 1
if (igen .gt. 4095) then
write(0,*) 'Error in p_getv0: seed exceeds 4095!'
end if
c
iseed(1) = igen/1000
igen = mod(igen,1000)
iseed(2) = igen/100
igen = mod(igen,100)
iseed(3) = igen/10
iseed(4) = mod(igen,10)
c
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pclarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call ccopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
rnorm0 = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pscnorm2( comm, n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett`s book, page 107 and in Gragg and Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call cgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl, j-1,
& MPI_COMPLEX, MPI_SUM, comm, ierr)
call cgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
rnorm = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5 ) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
cnorm2 = cmplx(rnorm,rzero)
call pcvout (comm, logfil, 1, cnorm2, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pcvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pcgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdnaup2.f 0000644 0001750 0001750 00000077237 12277373057 014216 0000000 0000000 c\BeginDoc
c
c\Name: pdnaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by pdnaupd .
c
c\Usage:
c call pdnaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pdnaupd .
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pdnaupd .
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (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 RITZR, Double precision arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from dneigh .
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Double precision 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pdgetv0 Parallel ARPACK initial vector generation routine.
c pdnaitr Parallel ARPACK Arnoldi factorization routine.
c pdnapps Parallel ARPACK application of implicit shifts routine.
c dnconv ARPACK convergence of Ritz values routine.
c pdneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pdngets Parallel ARPACK reorder Ritz values and error bounds routine.
c dsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c dswap Level 1 BLAS that swaps two vectors.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Revision history:
c Starting Point: Serial Code FILE: naup2.F SID: 2.2
c
c\SCCS Information:
c FILE: naup2.F SID: 1.5 DATE OF SID: 06/01/00
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Double precision
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character wprime*2
logical cnorm , getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, numcnv,
& j
Double precision
& rnorm , temp , eps23
save cnorm , getv0, initv , update, ushift,
& rnorm , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , eps23 , numcnv
c
Double precision
& rnorm_buf
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy , pdgetv0 , pdnaitr , dnconv ,
& pdneigh , pdngets , pdnapps ,
& pdvout , pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot , pdnorm2 , dlapy2 , pdlamch
external ddot , pdnorm2 , dlapy2 , pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = pdlamch (comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pdgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pdnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pdnapps . |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pdnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pdneigh ( comm, rnorm, kplusp, h, ldh, ritzr, ritzi,
& bounds, q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from pdneigh . |
c %----------------------------------------------------%
c
call dcopy (kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call dcopy (kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call dcopy (kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of pdngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call pdngets ( comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call dnconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call pivout (comm, logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call pdvout (comm, logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call pdvout (comm, logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call dvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with dngets , we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in dngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call dsortc (which, .true., nconv, ritzr, ritzi, bounds)
c
c
if (msglvl .gt. 1) then
call dvout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call dvout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call dvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pdngets (comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pdvout (comm, logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call pdvout (comm, logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call pdvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call dcopy (np, workl, 1, ritzr, 1)
call dcopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call pdvout (comm, logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call pdvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pdnapps (comm, n, nev, np, ritzr, ritzi, 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 pdnaitr . |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_DOUBLE_PRECISION , MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2 ( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pdmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pdnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psnapps.f 0000644 0001750 0001750 00000056022 12277373057 014316 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psnapps
c
c Message Passing Layer: MPI
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call psnapps
c ( COMM, N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Real array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to psnapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c slabad LAPACK routine that computes machine constants.
c slacpy LAPACK matrix copy routine.
c pslamch ScaLAPACK routine that determines machine constants.
c slanhs LAPACK routine that computes various norms of a matrix.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slarf LAPACK routine that applies Householder reflection to
c a matrix.
c slarfg LAPACK Householder reflection construction routine.
c slartg LAPACK Givens rotation construction routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another .
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: napps.F SID: 2.2
c
c\SCCS Information:
c FILE: napps.F SID: 1.5 DATE OF SID: 03/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine slahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnapps
& ( comm, n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid,
& q, ldq, workl, workd )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Real
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slarf, slarfg, slartg,
& slaset, slabad, arscnd, pivout, psvout, psmout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch, slanhs, slapy2
external pslamch, slanhs, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------------%
c
unfl = pslamch( comm, 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call psvout (comm, logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call psvout (comm, logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call psvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call slartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = slapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call slarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call slarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call slarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call slarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call sscal( kplusp-j+1, -one, h(j+1,j), ldh )
call sscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call sscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call sgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %---------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %---------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call saxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call psvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call psmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %----------------%
c | End of psnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pssaupd.f 0000644 0001750 0001750 00000071343 12277373057 014314 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pssaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pssaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pssaupd. 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 pssaupd 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 -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
c
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N.
c
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pssaupd 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), pssaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 psseupd. 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 psseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
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
c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
c subroutine psseupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 ssteqr.
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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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 psseupd.
c
c 2. If the Ritz vectors corresponding to the converged Ritz values
c are needed, the user must call psseupd immediately following completion
c of pssaupd. 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 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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 pssaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c sstats ARPACK routine that initializes timing and other statistics
c variables.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Authors
c Kristi Maschhoff ( Parallel Code )
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saupd.F SID: 2.4
c
c\SCCS Information:
c FILE: saupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pssaup2, psvout, pivout, arscnd, sstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pslamch(comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
call pssaup2
& ( comm, 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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pssaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
call psvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
call psvout (comm, logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.1' , 19x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pssaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcneigh.f 0000644 0001750 0001750 00000020527 12277373057 014250 0000000 0000000 c\BeginDoc
c
c\Name: pcneigh
c
c Message Passing Layer: MPI
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 pcneigh
c ( COMM, RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
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 pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c psvout Parallel 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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: neigh.F SID: 2.1
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcneigh (comm, rnorm, n, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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.0, 0.0), zero = (0.0, 0.0),
& rone = 1.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, csscal, ctrevc, ccopy,
& pcmout, pcvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2
external scnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mceigh
c
if (msglvl .gt. 2) then
call pcmout (comm, 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 pcvout (comm, 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 pcvout (comm, 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 pcvout (comm, logfil, n, ritz, ndigit,
& '_neigh: The eigenvalues of H')
call pcvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pcneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pznaup2.f 0000644 0001750 0001750 00000072512 12277373057 014233 0000000 0000000 c\BeginDoc
c
c\Name: pznaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by pznaupd.
c
c\Usage:
c call pznaup2
c ( COMM, 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 COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pznaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pznaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
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 (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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 PZNAUPD.
c
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
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pzgetv0 Parallel ARPACK initial vector generation routine.
c pznaitr Parallel ARPACK Arnoldi factorization routine.
c pznapps Parallel ARPACK application of implicit shifts routine.
c pzneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pzngets Parallel ARPACK reorder Ritz values and error bounds routine.
c zsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c pdvout ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK 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 pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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 FILE: naup2.F SID: 1.7 DATE OF SID: 10/25/03 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaup2
& ( comm, 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 )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical cnorm, getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex*16
& cmpnorm
Double precision
& rnorm, eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0, eps23
c
Double precision
& cmpnorm_buf
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy, pzgetv0, pznaitr, pzneigh, pzngets, pznapps,
& zsortc, zswap, pzmout, pzvout, pivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
Complex*16
& zdotc
Double precision
& pdznorm2, pdlamch, dlapy2
external zdotc, pdznorm2, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, min, max, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pzgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pznaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pznapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pznaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pzneigh ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
c | Ritz estimates obtained from pzneigh. |
c %--------------------------------------------------%
c
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 |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call pzngets ( comm, ishift, which, nev, np, ritz,
& bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
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)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call pzvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call pzvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call pzvout(comm, logfil, kplusp,
& workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call pzvout(comm, logfil, kplusp,
& workl(kplusp**2+kplusp+1), ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to pzneupd if needed |
c %------------------------------------------%
c
h(3,1) = dcmplx(rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call zsortc(wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, dlapy2( dble(ritz(j)),
& dimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call zsortc(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, dlapy2( dble(ritz(j)),
& dimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call zsortc(which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call pzvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call pzvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pzngets (comm, ishift, which, nev, np, ritz,
& bounds)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pzvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call pzvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call zcopy (np, workl, 1, ritz, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pzvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call pzvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pznapps(comm, 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 pznaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cmpnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pzmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pznaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/Makefile.in 0000644 0001750 0001750 00000104042 12277667632 014531 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/SRC/MPI
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libparpack_noopt_la_LIBADD =
am_libparpack_noopt_la_OBJECTS = libparpack_noopt_la-pslamch.lo \
libparpack_noopt_la-pdlamch.lo
libparpack_noopt_la_OBJECTS = $(am_libparpack_noopt_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
libparpack_noopt_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 \
$(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(F77LD) \
$(libparpack_noopt_la_FFLAGS) $(FFLAGS) $(AM_LDFLAGS) \
$(LDFLAGS) -o $@
libparpacksrcmpi_la_DEPENDENCIES = libparpack_noopt.la
am_libparpacksrcmpi_la_OBJECTS = libparpacksrcmpi_la-psgetv0.lo \
libparpacksrcmpi_la-psnaitr.lo libparpacksrcmpi_la-psnapps.lo \
libparpacksrcmpi_la-psnaup2.lo libparpacksrcmpi_la-psnaupd.lo \
libparpacksrcmpi_la-psneigh.lo libparpacksrcmpi_la-psngets.lo \
libparpacksrcmpi_la-pssaitr.lo libparpacksrcmpi_la-pssapps.lo \
libparpacksrcmpi_la-pssaup2.lo libparpacksrcmpi_la-pssaupd.lo \
libparpacksrcmpi_la-psseigt.lo libparpacksrcmpi_la-pssgets.lo \
libparpacksrcmpi_la-psneupd.lo libparpacksrcmpi_la-psseupd.lo \
libparpacksrcmpi_la-pslarnv.lo libparpacksrcmpi_la-psnorm2.lo \
libparpacksrcmpi_la-pdgetv0.lo libparpacksrcmpi_la-pdnaitr.lo \
libparpacksrcmpi_la-pdnapps.lo libparpacksrcmpi_la-pdnaup2.lo \
libparpacksrcmpi_la-pdnaupd.lo libparpacksrcmpi_la-pdneigh.lo \
libparpacksrcmpi_la-pdngets.lo libparpacksrcmpi_la-pdsaitr.lo \
libparpacksrcmpi_la-pdsapps.lo libparpacksrcmpi_la-pdsaup2.lo \
libparpacksrcmpi_la-pdsaupd.lo libparpacksrcmpi_la-pdseigt.lo \
libparpacksrcmpi_la-pdsgets.lo libparpacksrcmpi_la-pdneupd.lo \
libparpacksrcmpi_la-pdseupd.lo libparpacksrcmpi_la-pdlarnv.lo \
libparpacksrcmpi_la-pdnorm2.lo libparpacksrcmpi_la-pcnaitr.lo \
libparpacksrcmpi_la-pcnapps.lo libparpacksrcmpi_la-pcnaup2.lo \
libparpacksrcmpi_la-pcnaupd.lo libparpacksrcmpi_la-pcneigh.lo \
libparpacksrcmpi_la-pcneupd.lo libparpacksrcmpi_la-pcngets.lo \
libparpacksrcmpi_la-pcgetv0.lo libparpacksrcmpi_la-pscnorm2.lo \
libparpacksrcmpi_la-pclarnv.lo libparpacksrcmpi_la-pznaitr.lo \
libparpacksrcmpi_la-pznapps.lo libparpacksrcmpi_la-pznaup2.lo \
libparpacksrcmpi_la-pznaupd.lo libparpacksrcmpi_la-pzneigh.lo \
libparpacksrcmpi_la-pzneupd.lo libparpacksrcmpi_la-pzngets.lo \
libparpacksrcmpi_la-pzgetv0.lo libparpacksrcmpi_la-pdznorm2.lo \
libparpacksrcmpi_la-pzlarnv.lo
libparpacksrcmpi_la_OBJECTS = $(am_libparpacksrcmpi_la_OBJECTS)
libparpacksrcmpi_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 \
$(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(F77LD) \
$(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) $(AM_LDFLAGS) \
$(LDFLAGS) -o $@
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libparpack_noopt_la_SOURCES) \
$(libparpacksrcmpi_la_SOURCES)
DIST_SOURCES = $(libparpack_noopt_la_SOURCES) \
$(libparpacksrcmpi_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = $(MPIF77)
FFLAGS =
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libparpack_noopt.la libparpacksrcmpi.la
FFLAGS_SAV = @FFLAGS@
libparpack_noopt_la_SOURCES = pslamch.f pdlamch.f
libparpack_noopt_la_FFLAGS = -O0
libparpacksrcmpi_la_SOURCES = \
psgetv0.f \
psnaitr.f psnapps.f psnaup2.f psnaupd.f psneigh.f psngets.f \
pssaitr.f pssapps.f pssaup2.f pssaupd.f psseigt.f pssgets.f \
psneupd.f psseupd.f pslarnv.f psnorm2.f pdgetv0.f \
pdnaitr.f pdnapps.f pdnaup2.f pdnaupd.f pdneigh.f pdngets.f \
pdsaitr.f pdsapps.f pdsaup2.f pdsaupd.f pdseigt.f pdsgets.f \
pdneupd.f pdseupd.f pdlarnv.f pdnorm2.f \
pcnaitr.f pcnapps.f pcnaup2.f pcnaupd.f pcneigh.f \
pcneupd.f pcngets.f pcgetv0.f pscnorm2.f pclarnv.f \
pznaitr.f pznapps.f pznaup2.f pznaupd.f pzneigh.f \
pzneupd.f pzngets.f pzgetv0.f pdznorm2.f pzlarnv.f
libparpacksrcmpi_la_FFLAGS = $(FFLAGS_SAV)
libparpacksrcmpi_la_LIBADD = libparpack_noopt.la
EXTRA_DIST = debug.h stat.h
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/SRC/MPI/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/SRC/MPI/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libparpack_noopt.la: $(libparpack_noopt_la_OBJECTS) $(libparpack_noopt_la_DEPENDENCIES) $(EXTRA_libparpack_noopt_la_DEPENDENCIES)
$(AM_V_F77LD)$(libparpack_noopt_la_LINK) $(libparpack_noopt_la_OBJECTS) $(libparpack_noopt_la_LIBADD) $(LIBS)
libparpacksrcmpi.la: $(libparpacksrcmpi_la_OBJECTS) $(libparpacksrcmpi_la_DEPENDENCIES) $(EXTRA_libparpacksrcmpi_la_DEPENDENCIES)
$(AM_V_F77LD)$(libparpacksrcmpi_la_LINK) $(libparpacksrcmpi_la_OBJECTS) $(libparpacksrcmpi_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
libparpack_noopt_la-pslamch.lo: pslamch.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpack_noopt_la_FFLAGS) $(FFLAGS) -c -o libparpack_noopt_la-pslamch.lo `test -f 'pslamch.f' || echo '$(srcdir)/'`pslamch.f
libparpack_noopt_la-pdlamch.lo: pdlamch.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpack_noopt_la_FFLAGS) $(FFLAGS) -c -o libparpack_noopt_la-pdlamch.lo `test -f 'pdlamch.f' || echo '$(srcdir)/'`pdlamch.f
libparpacksrcmpi_la-psgetv0.lo: psgetv0.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psgetv0.lo `test -f 'psgetv0.f' || echo '$(srcdir)/'`psgetv0.f
libparpacksrcmpi_la-psnaitr.lo: psnaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psnaitr.lo `test -f 'psnaitr.f' || echo '$(srcdir)/'`psnaitr.f
libparpacksrcmpi_la-psnapps.lo: psnapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psnapps.lo `test -f 'psnapps.f' || echo '$(srcdir)/'`psnapps.f
libparpacksrcmpi_la-psnaup2.lo: psnaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psnaup2.lo `test -f 'psnaup2.f' || echo '$(srcdir)/'`psnaup2.f
libparpacksrcmpi_la-psnaupd.lo: psnaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psnaupd.lo `test -f 'psnaupd.f' || echo '$(srcdir)/'`psnaupd.f
libparpacksrcmpi_la-psneigh.lo: psneigh.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psneigh.lo `test -f 'psneigh.f' || echo '$(srcdir)/'`psneigh.f
libparpacksrcmpi_la-psngets.lo: psngets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psngets.lo `test -f 'psngets.f' || echo '$(srcdir)/'`psngets.f
libparpacksrcmpi_la-pssaitr.lo: pssaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pssaitr.lo `test -f 'pssaitr.f' || echo '$(srcdir)/'`pssaitr.f
libparpacksrcmpi_la-pssapps.lo: pssapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pssapps.lo `test -f 'pssapps.f' || echo '$(srcdir)/'`pssapps.f
libparpacksrcmpi_la-pssaup2.lo: pssaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pssaup2.lo `test -f 'pssaup2.f' || echo '$(srcdir)/'`pssaup2.f
libparpacksrcmpi_la-pssaupd.lo: pssaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pssaupd.lo `test -f 'pssaupd.f' || echo '$(srcdir)/'`pssaupd.f
libparpacksrcmpi_la-psseigt.lo: psseigt.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psseigt.lo `test -f 'psseigt.f' || echo '$(srcdir)/'`psseigt.f
libparpacksrcmpi_la-pssgets.lo: pssgets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pssgets.lo `test -f 'pssgets.f' || echo '$(srcdir)/'`pssgets.f
libparpacksrcmpi_la-psneupd.lo: psneupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psneupd.lo `test -f 'psneupd.f' || echo '$(srcdir)/'`psneupd.f
libparpacksrcmpi_la-psseupd.lo: psseupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psseupd.lo `test -f 'psseupd.f' || echo '$(srcdir)/'`psseupd.f
libparpacksrcmpi_la-pslarnv.lo: pslarnv.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pslarnv.lo `test -f 'pslarnv.f' || echo '$(srcdir)/'`pslarnv.f
libparpacksrcmpi_la-psnorm2.lo: psnorm2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-psnorm2.lo `test -f 'psnorm2.f' || echo '$(srcdir)/'`psnorm2.f
libparpacksrcmpi_la-pdgetv0.lo: pdgetv0.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdgetv0.lo `test -f 'pdgetv0.f' || echo '$(srcdir)/'`pdgetv0.f
libparpacksrcmpi_la-pdnaitr.lo: pdnaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdnaitr.lo `test -f 'pdnaitr.f' || echo '$(srcdir)/'`pdnaitr.f
libparpacksrcmpi_la-pdnapps.lo: pdnapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdnapps.lo `test -f 'pdnapps.f' || echo '$(srcdir)/'`pdnapps.f
libparpacksrcmpi_la-pdnaup2.lo: pdnaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdnaup2.lo `test -f 'pdnaup2.f' || echo '$(srcdir)/'`pdnaup2.f
libparpacksrcmpi_la-pdnaupd.lo: pdnaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdnaupd.lo `test -f 'pdnaupd.f' || echo '$(srcdir)/'`pdnaupd.f
libparpacksrcmpi_la-pdneigh.lo: pdneigh.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdneigh.lo `test -f 'pdneigh.f' || echo '$(srcdir)/'`pdneigh.f
libparpacksrcmpi_la-pdngets.lo: pdngets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdngets.lo `test -f 'pdngets.f' || echo '$(srcdir)/'`pdngets.f
libparpacksrcmpi_la-pdsaitr.lo: pdsaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdsaitr.lo `test -f 'pdsaitr.f' || echo '$(srcdir)/'`pdsaitr.f
libparpacksrcmpi_la-pdsapps.lo: pdsapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdsapps.lo `test -f 'pdsapps.f' || echo '$(srcdir)/'`pdsapps.f
libparpacksrcmpi_la-pdsaup2.lo: pdsaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdsaup2.lo `test -f 'pdsaup2.f' || echo '$(srcdir)/'`pdsaup2.f
libparpacksrcmpi_la-pdsaupd.lo: pdsaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdsaupd.lo `test -f 'pdsaupd.f' || echo '$(srcdir)/'`pdsaupd.f
libparpacksrcmpi_la-pdseigt.lo: pdseigt.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdseigt.lo `test -f 'pdseigt.f' || echo '$(srcdir)/'`pdseigt.f
libparpacksrcmpi_la-pdsgets.lo: pdsgets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdsgets.lo `test -f 'pdsgets.f' || echo '$(srcdir)/'`pdsgets.f
libparpacksrcmpi_la-pdneupd.lo: pdneupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdneupd.lo `test -f 'pdneupd.f' || echo '$(srcdir)/'`pdneupd.f
libparpacksrcmpi_la-pdseupd.lo: pdseupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdseupd.lo `test -f 'pdseupd.f' || echo '$(srcdir)/'`pdseupd.f
libparpacksrcmpi_la-pdlarnv.lo: pdlarnv.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdlarnv.lo `test -f 'pdlarnv.f' || echo '$(srcdir)/'`pdlarnv.f
libparpacksrcmpi_la-pdnorm2.lo: pdnorm2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdnorm2.lo `test -f 'pdnorm2.f' || echo '$(srcdir)/'`pdnorm2.f
libparpacksrcmpi_la-pcnaitr.lo: pcnaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcnaitr.lo `test -f 'pcnaitr.f' || echo '$(srcdir)/'`pcnaitr.f
libparpacksrcmpi_la-pcnapps.lo: pcnapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcnapps.lo `test -f 'pcnapps.f' || echo '$(srcdir)/'`pcnapps.f
libparpacksrcmpi_la-pcnaup2.lo: pcnaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcnaup2.lo `test -f 'pcnaup2.f' || echo '$(srcdir)/'`pcnaup2.f
libparpacksrcmpi_la-pcnaupd.lo: pcnaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcnaupd.lo `test -f 'pcnaupd.f' || echo '$(srcdir)/'`pcnaupd.f
libparpacksrcmpi_la-pcneigh.lo: pcneigh.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcneigh.lo `test -f 'pcneigh.f' || echo '$(srcdir)/'`pcneigh.f
libparpacksrcmpi_la-pcneupd.lo: pcneupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcneupd.lo `test -f 'pcneupd.f' || echo '$(srcdir)/'`pcneupd.f
libparpacksrcmpi_la-pcngets.lo: pcngets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcngets.lo `test -f 'pcngets.f' || echo '$(srcdir)/'`pcngets.f
libparpacksrcmpi_la-pcgetv0.lo: pcgetv0.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pcgetv0.lo `test -f 'pcgetv0.f' || echo '$(srcdir)/'`pcgetv0.f
libparpacksrcmpi_la-pscnorm2.lo: pscnorm2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pscnorm2.lo `test -f 'pscnorm2.f' || echo '$(srcdir)/'`pscnorm2.f
libparpacksrcmpi_la-pclarnv.lo: pclarnv.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pclarnv.lo `test -f 'pclarnv.f' || echo '$(srcdir)/'`pclarnv.f
libparpacksrcmpi_la-pznaitr.lo: pznaitr.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pznaitr.lo `test -f 'pznaitr.f' || echo '$(srcdir)/'`pznaitr.f
libparpacksrcmpi_la-pznapps.lo: pznapps.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pznapps.lo `test -f 'pznapps.f' || echo '$(srcdir)/'`pznapps.f
libparpacksrcmpi_la-pznaup2.lo: pznaup2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pznaup2.lo `test -f 'pznaup2.f' || echo '$(srcdir)/'`pznaup2.f
libparpacksrcmpi_la-pznaupd.lo: pznaupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pznaupd.lo `test -f 'pznaupd.f' || echo '$(srcdir)/'`pznaupd.f
libparpacksrcmpi_la-pzneigh.lo: pzneigh.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pzneigh.lo `test -f 'pzneigh.f' || echo '$(srcdir)/'`pzneigh.f
libparpacksrcmpi_la-pzneupd.lo: pzneupd.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pzneupd.lo `test -f 'pzneupd.f' || echo '$(srcdir)/'`pzneupd.f
libparpacksrcmpi_la-pzngets.lo: pzngets.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pzngets.lo `test -f 'pzngets.f' || echo '$(srcdir)/'`pzngets.f
libparpacksrcmpi_la-pzgetv0.lo: pzgetv0.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pzgetv0.lo `test -f 'pzgetv0.f' || echo '$(srcdir)/'`pzgetv0.f
libparpacksrcmpi_la-pdznorm2.lo: pdznorm2.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pdznorm2.lo `test -f 'pdznorm2.f' || echo '$(srcdir)/'`pdznorm2.f
libparpacksrcmpi_la-pzlarnv.lo: pzlarnv.f
$(AM_V_F77)$(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(libparpacksrcmpi_la_FFLAGS) $(FFLAGS) -c -o libparpacksrcmpi_la-pzlarnv.lo `test -f 'pzlarnv.f' || echo '$(srcdir)/'`pzlarnv.f
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdsapps.f 0000644 0001750 0001750 00000044644 12277373057 014313 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pdsapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Double precision array of length NP. (INPUT)
c The shifts to be applied.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlartg LAPACK Givens rotation construction routine.
c dlacpy LAPACK matrix copy routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sapps.F SID: 2.4
c
c\SCCS Information:
c FILE: sapps.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Double precision
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, pdvout,
& pivout, arscnd, dgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = pdlamch(comm, 'Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call dscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call pdvout (comm, logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call pdvout (comm, logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call pdvout (comm, logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdsapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pssgets.f 0000644 0001750 0001750 00000017062 12277373057 014323 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssgets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pssgets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Real array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Real array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortr ARPACK utility sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
c sswap Level 1 BLAS that swaps the contents of two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sgets.F SID: 2.3
c
c\SCCS Information:
c FILE: sgets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssgets
& ( comm, ishift, which, kev, np, ritz, bounds, shifts )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external sswap, scopy, ssortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call ssortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call sswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call sswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call ssortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pssapps. |
c %-------------------------------------------------------%
c
call ssortr ('SM', .true., np, bounds, ritz)
call scopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call psvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call psvout (comm, logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %----------------%
c | End of pssgets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdnaupd.f 0000644 0001750 0001750 00000073235 12277373057 014272 0000000 0000000 c\BeginDoc
c
c\Name: pdnaupd
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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 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.
c
c pdnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pdnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdnaupd . 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 pdnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Double precision array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pdnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), pdnaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by dneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 pdneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
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 an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine dneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine dneupd .
c
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 pdnaupd . This is new starting with release 2 of ARPACK.
c
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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pdnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.9 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdnaup2 , pdvout , pivout, arscnd, dstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pdlamch (comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine pdneigh called |
c | by pdnaup2 . Subroutine dneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pdnaup2
& ( comm, ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pdnaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pdvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call pdvout (comm, logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call pdvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pdnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pzgetv0.f 0000644 0001750 0001750 00000034460 12277373057 014233 0000000 0000000 c\BeginDoc
c
c\Name: pzgetv0
c
c Message Passing Layer: MPI
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pzgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pzgetv0 .
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pzgetv0 is called.
c It should be set to 1 on the initial call to pzgetv0 .
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex*16 N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex*16 work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Complex*16 work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pzvout Parallel ARPACK utility routine that prints vectors.
c pzlarnv Parallel wrapper for LAPACK routine zlarnv (generates a random vector).
c zgemv Level 2 BLAS routine for matrix vector multiplication.
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 pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: getv0.F SID: 2.1
c
c\SCCS Information:
c FILE: getv0.F SID: 1.7 DATE OF SID: 04/12/01
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) ,
& rzero = 0.0 )
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj, myid, igen
Double precision
& rnorm0
Complex*16
& cnorm, cnorm2
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Complex*16
& cnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy , zgemv , pzlarnv , pzvout , arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdznorm2 , dlapy2
Complex*16
& zdotc
external zdotc , pdznorm2 , dlapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
c
c %-----------------------------------%
c | Generate a seed on each processor |
c | using process id (myid). |
c | Note: the seed must be between 1 |
c | and 4095. iseed(4) must be odd. |
c %-----------------------------------%
c
call MPI_COMM_RANK(comm, myid, ierr)
igen = 1000 + 2*myid + 1
if (igen .gt. 4095) then
write(0,*) 'Error in p_getv0: seed exceeds 4095!'
end if
c
iseed(1) = igen/1000
igen = mod(igen,1000)
iseed(2) = igen/100
igen = mod(igen,100)
iseed(3) = igen/10
iseed(4) = mod(igen,10)
c
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pzlarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call zcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
rnorm0 = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pdznorm2 ( comm, n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett`s book, page 107 and in Gragg and Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call zgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl, j-1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr)
call zgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
rnorm = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2 (comm, n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5 ) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
cnorm2 = dcmplx (rnorm,rzero)
call pzvout (comm, logfil, 1, cnorm2, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pzvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pzgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdsgets.f 0000644 0001750 0001750 00000017156 12277373057 014310 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsgets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pdsgets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Double precision array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortr ARPACK utility sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
c dswap Level 1 BLAS that swaps the contents of two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sgets.F SID: 2.3
c
c\SCCS Information:
c FILE: sgets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsgets
& ( comm, ishift, which, kev, np, ritz, bounds, shifts )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dswap, dcopy, dsortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call dsortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call dswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call dswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call dsortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pdsapps. |
c %-------------------------------------------------------%
c
call dsortr ('SM', .true., np, bounds, ritz)
call dcopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pdvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %----------------%
c | End of pdsgets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdlamch.f 0000644 0001750 0001750 00000005570 12277373057 014244 0000000 0000000 DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH )
include "mpif.h"
*
* -- ScaLAPACK auxilliary routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
CHARACTER CMACH
INTEGER ICTXT
* ..
*
* Purpose
* =======
*
* PDLAMCH determines double precision machine parameters.
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle in which the computation takes
* place.
*
* CMACH (global input) CHARACTER*1
* Specifies the value to be returned by PDLAMCH:
* = 'E' or 'e', PDLAMCH := eps
* = 'S' or 's , PDLAMCH := sfmin
* = 'B' or 'b', PDLAMCH := base
* = 'P' or 'p', PDLAMCH := eps*base
* = 'N' or 'n', PDLAMCH := t
* = 'R' or 'r', PDLAMCH := rnd
* = 'M' or 'm', PDLAMCH := emin
* = 'U' or 'u', PDLAMCH := rmin
* = 'L' or 'l', PDLAMCH := emax
* = 'O' or 'o', PDLAMCH := rmax
*
* where
*
* eps = relative machine precision
* sfmin = safe minimum, such that 1/sfmin does not overflow
* base = base of the machine
* prec = eps*base
* t = number of (base) digits in the mantissa
* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
* emin = minimum exponent before (gradual) underflow
* rmin = underflow threshold - base**(emin-1)
* emax = largest exponent before overflow
* rmax = overflow threshold - (base**emax)*(1-eps)
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER IDUMM
DOUBLE PRECISION TEMP, TEMP1
* ..
* .. External Subroutines ..
* EXTERNAL DGAMN2D, DGAMX2D
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH
EXTERNAL DLAMCH, LSAME
* ..
* .. Executable Statements ..
*
TEMP1 = DLAMCH( CMACH )
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,
$ MPI_MAX, ICTXT, IDUMM )
* CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_DOUBLE_PRECISION,
$ MPI_MIN, ICTXT, IDUMM )
* CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE
TEMP = TEMP1
END IF
*
PDLAMCH = TEMP
*
* End of PDLAMCH
*
END
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcnapps.f 0000644 0001750 0001750 00000043116 12277373057 014276 0000000 0000000 c\BeginDoc
c
c\Name: pcnapps
c
c Message Passing Layer: MPI
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pcnapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c clacpy LAPACK matrix copy routine.
c clanhs LAPACK routine that computes various norms of a matrix.
c clartg LAPACK Givens rotation construction routine.
c claset LAPACK matrix initialization routine.
c slabad LAPACK routine for defining the underflow and overflow
c limits.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another.
c cscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: napps.F SID: 2.1
c
c\SCCS Information:
c FILE: napps.F SID: 1.4 DATE OF SID: 10/25/03
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine clahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex
& cdum, f, g, h11, h21, r, s, sigma, t
Real
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cgemv, cscal, clacpy, clartg,
& pcvout, claset, slabad, pcmout, arscnd, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& clanhs, pslamch, slapy2
external clanhs, pslamch, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, aimag, conjg, cmplx, max, min, real
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Real
& cabs1
cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------------%
c
unfl = pslamch( comm, 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call claset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pcvout (comm, logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %----------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = clanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(real(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pcvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call clartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( real( h(j+1,j) ) .lt. rzero .or.
& aimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / slapy2(real(h(j+1,j)),aimag(h(j+1,j)))
call cscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call cscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call cscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = cmplx( real( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = clanhs( '1', kev, h, ldh, workl )
if( real( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call cgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call cgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call ccopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call clacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call ccopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call cscal (n, q(kplusp,kev), resid, 1)
if ( real( h(kev+1,kev) ) .gt. rzero )
& call caxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pcvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pcmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pcnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcnaup2.f 0000644 0001750 0001750 00000072312 12277373057 014202 0000000 0000000 c\BeginDoc
c
c\Name: pcnaup2
c
c Message Passing Layer: MPI
c
c\Description:
c Intermediate level interface called by pcnaupd.
c
c\Usage:
c call pcnaup2
c ( COMM, 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 COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pcnaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pcnaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
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 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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 PCNAUPD.
c
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
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pcgetv0 Parallel ARPACK initial vector generation routine.
c pcnaitr Parallel ARPACK Arnoldi factorization routine.
c pcnapps Parallel ARPACK application of implicit shifts routine.
c pcneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pcngets Parallel ARPACK reorder Ritz values and error bounds routine.
c csortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c psvout ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c cswap Level 1 BLAS that swaps two vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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 FILE: naup2.F SID: 1.7 DATE OF SID: 10/25/03 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaup2
& ( comm, 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 )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical cnorm, getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex
& cmpnorm
Real
& rnorm, eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0, eps23
c
Real
& cmpnorm_buf
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, pcgetv0, pcnaitr, pcneigh, pcngets, pcnapps,
& csortc, cswap, pcmout, pcvout, pivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
Complex
& cdotc
Real
& pscnorm2, pslamch, slapy2
external cdotc, pscnorm2, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real, min, max, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pcgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pcnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pcnapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pcnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pcneigh ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
c | Ritz estimates obtained from pcneigh. |
c %--------------------------------------------------%
c
call ccopy(kplusp,ritz,1,workl(kplusp**2+1),1)
call ccopy(kplusp,bounds,1,workl(kplusp**2+kplusp+1),1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call pcngets ( comm, ishift, which, nev, np, ritz,
& bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
c
nconv = 0
c
do 25 i = 1, nev
rtemp = max( eps23, slapy2( real(ritz(np+i)),
& aimag(ritz(np+i)) ) )
if ( slapy2(real(bounds(np+i)),aimag(bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call pcvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call pcvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call pcvout(comm, logfil, kplusp,
& workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call pcvout(comm, logfil, kplusp,
& workl(kplusp**2+kplusp+1), ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to pcneupd if needed |
c %------------------------------------------%
c
h(3,1) = cmplx(rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call csortc(wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, slapy2( real(ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call csortc(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, slapy2( real(ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call csortc(which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call pcvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call pcvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pcngets (comm, ishift, which, nev, np, ritz,
& bounds)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pcvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call pcvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call ccopy (np, workl, 1, ritz, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pcvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call pcvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pcnapps(comm, 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 pcnaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cmpnorm_buf = cdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( cmpnorm_buf, cmpnorm, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pcmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pcnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psgetv0.f 0000644 0001750 0001750 00000033265 12277373057 014226 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psgetv0
c
c Message Passing Layer: MPI
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call psgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to psgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that psgetv0 is called.
c It should be set to 1 on the initial call to psgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Real N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Real work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine for vector output.
c pslarnv Parallel wrapper for LAPACK routine slarnv (generates a random vector).
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: getv0.F SID: 2.3
c
c\SCCS Information:
c FILE: getv0.F SID: 1.4 DATE OF SID: 3/19/97
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Real
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
Real
& rnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pslarnv, psvout, scopy, sgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2
external sdot, psnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pslarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call scopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm0, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = psnorm2( comm, n, resid, 1 )
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call sgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl, j-1,
& MPI_REAL, MPI_SUM, comm, ierr)
call sgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call psvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of psgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdnapps.f 0000644 0001750 0001750 00000056226 12277373057 014305 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdnapps
c
c Message Passing Layer: MPI
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pdnapps
c ( COMM, N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Double precision array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to pdnapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c dlabad LAPACK routine that computes machine constants.
c dlacpy LAPACK matrix copy routine.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dlarf LAPACK routine that applies Householder reflection to
c a matrix.
c dlarfg LAPACK Householder reflection construction routine.
c dlartg LAPACK Givens rotation construction routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another .
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: napps.F SID: 2.2
c
c\SCCS Information:
c FILE: napps.F SID: 1.5 DATE OF SID: 03/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnapps
& ( comm, n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid,
& q, ldq, workl, workd )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Double precision
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlarf, dlarfg, dlartg,
& dlaset, dlabad, arscnd, pivout, pdvout, pdmout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch, dlanhs, dlapy2
external pdlamch, dlanhs, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------------%
c
unfl = pdlamch( comm, 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pdvout (comm, logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call pdvout (comm, logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pdvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call dlartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = dlapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call dlarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call dlarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call dlarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call dlarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call dscal( kplusp-j+1, -one, h(j+1,j), ldh )
call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %---------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %---------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pdmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pdnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pznapps.f 0000644 0001750 0001750 00000043240 12277373057 014323 0000000 0000000 c\BeginDoc
c
c\Name: pznapps
c
c Message Passing Layer: MPI
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pznapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex*16 array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex*16 N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex*16 KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex*16 work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zlacpy LAPACK matrix copy routine.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlartg LAPACK Givens rotation construction routine.
c zlaset LAPACK matrix initialization routine.
c dlabad LAPACK routine for defining the underflow and overflow
c limits.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
c zcopy Level 1 BLAS that copies one vector to another.
c zscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: napps.F SID: 2.1
c
c\SCCS Information:
c FILE: napps.F SID: 1.4 DATE OF SID: 10/25/03
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine zlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex*16
& cdum, f, g, h11, h21, r, s, sigma, t
Double precision
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zgemv, zscal, zlacpy, zlartg,
& pzvout, zlaset, dlabad, pzmout, arscnd, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& zlanhs, pdlamch, dlapy2
external zlanhs, pdlamch, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, dimag, conjg, dcmplx, max, min, dble
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Double precision
& cabs1
cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------------%
c
unfl = pdlamch( comm, 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call zlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pzvout (comm, logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %----------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = zlanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(dble(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pzvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call zlartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( dble( h(j+1,j) ) .lt. rzero .or.
& dimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / dlapy2(dble(h(j+1,j)),dimag(h(j+1,j)))
call zscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call zscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call zscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = dcmplx( dble( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = zlanhs( '1', kev, h, ldh, workl )
if( dble( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call zgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call zcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call zlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call zscal (n, q(kplusp,kev), resid, 1)
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zaxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pzvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pzmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pznapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdnorm2.f 0000644 0001750 0001750 00000003533 12277373057 014212 0000000 0000000 c\BeginDoc
c
c\Name: pdnorm2
c
c Message Passing Layer: MPI
c
c\Description:
c
c\Usage:
c call pdnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 2/22/96
c
c-----------------------------------------------------------------------
c
Double precision function pdnorm2 ( comm, n, x, inc )
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm, ierr
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dnrm2
External dnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pdnorm2 = dnrm2( n, x, inc)
c
buf = pdnorm2
call MPI_ALLREDUCE( buf, max, 1, MPI_DOUBLE_PRECISION,
& MPI_MAX, comm, ierr )
if ( max .eq. zero ) then
pdnorm2 = zero
else
buf = (pdnorm2/max)**2.0
call MPI_ALLREDUCE( buf, pdnorm2, 1, MPI_DOUBLE_PRECISION,
& MPI_SUM, comm, ierr )
pdnorm2 = max * sqrt(abs(pdnorm2))
endif
c
c %----------------%
c | End of pdnorm2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psnaupd.f 0000644 0001750 0001750 00000072765 12277373057 014320 0000000 0000000 c\BeginDoc
c
c\Name: psnaupd
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c psnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call psnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to psnaupd. 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 psnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Real array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 psnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), psnaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by sneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 psneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
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
c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine sneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine sneupd.
c
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 psnaupd. This is new starting with release 2 of ARPACK.
c
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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Real resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Real resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c psnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.9 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external psnaup2, psvout, pivout, arscnd, sstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pslamch(comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine psneigh called |
c | by psnaup2. Subroutine sneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call psnaup2
& ( comm, ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within psnaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call psvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call psvout (comm, logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call psvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of psnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdsaupd.f 0000644 0001750 0001750 00000071560 12277373057 014276 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaupd
c
c Message Passing Layer: MPI
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pdsaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pdsaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdsaupd . 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 pdsaupd 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 -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
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 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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pdsaupd 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), pdsaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 pdseupd . 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 pdseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
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 pdseupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 = -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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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 pdseupd .
c
c 2. If the Ritz vectors corresponding to the converged Ritz values
c are needed, the user must call pdseupd immediately following completion
c of pdsaupd . 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 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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 pdsaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c dstats ARPACK routine that initializes timing and other statistics
c variables.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Authors
c Kristi Maschhoff ( Parallel Code )
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saupd.F SID: 2.4
c
c\SCCS Information:
c FILE: saupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
include 'mpif.h'
c
c %------------------%
c | MPI Variables |
c %------------------%
c
integer comm, myid
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdsaup2 , pdvout , pivout, arscnd, dstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pdlamch (comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
call pdsaup2
& ( comm, 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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pdsaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
call pdvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
call pdvout (comm, logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
call MPI_COMM_RANK( comm, myid, ierr )
if ( myid .eq. 0 ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.1' , 19x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pdsaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcngets.f 0000644 0001750 0001750 00000013466 12277373057 014302 0000000 0000000 c\BeginDoc
c
c\Name: pcngets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pcngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\Routines called:
c csortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcvout Parallel ARPACK utility routine that prints vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: ngets.F SID: 2.1
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcngets ( comm, ishift, which, kev, np, ritz, bounds)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pcvout, csortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call csortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pcnapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call csortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pcvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pcvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pcngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pssapps.f 0000644 0001750 0001750 00000044454 12277373057 014331 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pssapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Real array of length NP. (INPUT)
c The shifts to be applied.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slartg LAPACK Givens rotation construction routine.
c slacpy LAPACK matrix copy routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sapps.F SID: 2.4
c
c\SCCS Information:
c FILE: sapps.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Real
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slartg, slaset, psvout,
& pivout, arscnd, sgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = pslamch(comm, 'Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call sscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call sgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call saxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call psvout (comm, logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call psvout (comm, logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call psvout (comm, logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pssapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdsaitr.f 0000644 0001750 0001750 00000077165 12277373057 014313 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pdsaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pdsaitr
c ( COMM, IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See pdsaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c pdgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c pdmout Parallel ARPACK utility routine that prints matrices.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saitr.F SID: 2.3
c
c\SCCS Information:
c FILE: saitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pdsaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaitr
& (comm, ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Double precision
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
Double precision
& rnorm_buf
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, pdgetv0, pdvout, pdmout,
& dlascl, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, pdlamch
external ddot, pdnorm2, pdlamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = pdlamch(comm,'safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pdgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pdgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
rnorm_buf = ddot (n, resid, 1, workd(ivj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
else if (mode .eq. 2) then
call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv('N', n, j, -one, v, ldv, workl(1), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workl(j)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workl(j)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call dscal(n, -one, v(1,j+1), 1)
else
call dscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call pdvout (comm, logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pdsaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pzngets.f 0000644 0001750 0001750 00000013505 12277373057 014323 0000000 0000000 c\BeginDoc
c
c\Name: pzngets
c
c Message Passing Layer: MPI
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pzngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c zsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzvout Parallel ARPACK utility routine that prints vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: ngets.F SID: 2.1
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzngets ( comm, ishift, which, kev, np, ritz, bounds)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pzvout, zsortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call zsortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pznapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call zsortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pzvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pzvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pzngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pzneupd.f 0000644 0001750 0001750 00000105000 12277373057 014306 0000000 0000000 c\BeginDoc
c
c\Name: pzneupd
c
c Message Passing Layer: MPI
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PZNAUPD. PZNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of PZNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of PZNAUPD.
c
c\Usage:
c call pzneupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 PZNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to PZNAUPD 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, RWORK, INFO
c
c must be passed directly to ZNEUPD following the last call
c to PZNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PZNAUPD and the call to ZNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex*16 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 PZNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c PZNAUPD. They are not changed by PZNEUPD.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 PZNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 PZNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ztrsen.
c Re-enter subroutine pzneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ztrevc.
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: PZNAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine that computes the Schur form of a
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form.
c ztrsen LAPACK routine that re-orders the Schur form.
c zunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c pdlamch ScaLAPACK routine that determines machine constants.
c ztrmm Level 3 BLAS matrix times an upper triangular matrix.
c zgeru Level 2 BLAS rank one update to a matrix.
c zcopy Level 1 BLAS that copies one vector to another .
c zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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
c upper triangular matrix stored workl(ipntr(12)).
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: neupd.F SID: 2.2
c
c\SCCS Information:
c FILE: neupd.F SID: 1.9 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pzneupd
& ( comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex*16
& sigma
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Double precision
& rwork(ncv)
Complex*16
& d(nev) , resid(n) , v(ldv,ncv) ,
& z(ldz, nev), workd(3*n), workl(lworkl),
& workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift
Complex*16
& rnorm, temp, vl(1)
Double precision
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy ,zgeru,zgeqr2,zlacpy,pzmout,
& zunm2r,ztrmm,pzvout,pivout,
& zlahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2,pdlamch,dlapy2
external dznrm2,pdlamch,dlapy2
c
Complex*16
& zdotc
external zdotc
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pzvout(comm, logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values passed in from _NAUPD.')
call pzvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pzngets(comm, ishift, which ,
& nev , np , workl(irz),
& workl(bounds))
c
if (msglvl .gt. 2) then
call pzvout(comm,logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values after calling _NGETS.')
call pzvout(comm,logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 zlahqr to compute the Schur form |
c | of the upper Hessenberg matrix returned by PZNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pzvout(comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
call pzvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pzmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
if (reord) then
c
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)
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pzvout (comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pzmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call zcopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call zcopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using zunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | ztrevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = dznrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = dble(one) / rtemp
call zdscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
call zcopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call pzvout(comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pzmout(comm, logfil, nconv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call zcopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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
end if
c
else
c
c %--------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PZNAUPD 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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pzvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call pzvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call pzvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call pzvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call zgeru(n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pzneupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psseigt.f 0000644 0001750 0001750 00000012725 12277373057 014312 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psseigt
c
c Message Passing Layer: MPI
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call psseigt
c ( COMM, RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RNORM Real scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Real N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Real array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Real work array of length 3*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 sstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c sstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seigt.F SID: 2.2
c
c\SCCS Information:
c FILE: seigt.F SID: 1.3 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psseigt
& ( comm, rnorm, n, h, ldh, eig, bounds, workl, ierr )
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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, ldh, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, sstqrb, psvout, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call psvout (comm, logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
c
call scopy (n, h(1,2), 1, eig, 1)
call scopy (n-1, h(2,1), 1, workl, 1)
call sstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %-----------------%
c | End of psseigt |
c %-----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pzneigh.f 0000644 0001750 0001750 00000020706 12277373057 014276 0000000 0000000 c\BeginDoc
c
c\Name: pzneigh
c
c Message Passing Layer: MPI
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 pzneigh
c ( COMM, RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RNORM Double precision 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*16 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*16 array of length N. (OUTPUT)
c On output, RITZ(1:N) contains the eigenvalues of H.
c
c BOUNDS Complex*16 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*16 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*16 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 Double precision 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 zlahqr or ztrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c pdvout Parallel ARPACK utility routine that prints vectors.
c zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine to compute the Schur form of an
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form
c zcopy Level 1 BLAS that copies one vector to another.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: neigh.F SID: 2.1
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzneigh (comm, rnorm, n, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
c %--------------------%
c | MPI Communicator |
c %--------------------%
c
integer comm
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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(n), h(ldh,n), q(ldq,n), ritz(n),
& workl(n*(n+3))
Double precision
& rwork(n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer j, msglvl
Complex*16
& vl(1)
Double precision
& temp
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zlacpy, zlahqr, zdscal, ztrevc, zcopy,
& pzmout, pzvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
external dznrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mceigh
c
if (msglvl .gt. 2) then
call pzmout (comm, 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 | zlahqr returns the full Schur form of H |
c | in WORKL(1:N**2), and the Schur vectors in q. |
c %----------------------------------------------------------%
c
call zlacpy ('All', n, n, h, ldh, workl, n)
call zlaset ('All', n, n, zero, one, q, ldq)
call zlahqr (.true., .true., n, 1, n, workl, ldh, ritz,
& 1, n, q, ldq, ierr)
if (ierr .ne. 0) go to 9000
c
call zcopy (n, q(n-1,1), ldq, bounds, 1)
if (msglvl .gt. 1) then
call pzvout (comm, 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 ztrevc ('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 | ztrevc 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 = dznrm2( n, q(1,j), 1 )
call zdscal ( n, rone / temp, q(1,j), 1 )
10 continue
c
if (msglvl .gt. 1) then
call zcopy(n, q(n,1), ldq, workl, 1)
call pzvout (comm, 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 zcopy(n, q(n,1), n, bounds, 1)
call zdscal(n, rnorm, bounds, 1)
c
if (msglvl .gt. 2) then
call pzvout (comm, logfil, n, ritz, ndigit,
& '_neigh: The eigenvalues of H')
call pzvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pzneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pznaitr.f 0000644 0001750 0001750 00000077224 12277373057 014330 0000000 0000000 c\BeginDoc
c
c\Name: pznaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pznaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pznaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pznaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex*16 N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Complex*16 work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pzgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlascl LAPACK routine for careful scaling of a matrix.
c dlabad LAPACK routine for defining the underflow and overflow
c limits
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
c zcopy Level 1 BLAS that copies one vector to another .
c zdotc Level 1 BLAS that computes the scalar product of
c two vectors.
c zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c pdznorm2 Parallel version of Level 1 BLAS that computes the
c norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: naitr.F SID: 2.1
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pznaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone, rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0, rzero = 0.0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex*16
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Complex*16
& cnorm_buf
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zscal, zgemv, pzgetv0, dlabad,
& zdscal, pzvout, pzmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
Double precision
& pdlamch, pdznorm2, zlanhs, dlapy2
external zdotc, pdznorm2, zlanhs, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------%
c
unfl = pdlamch(comm, 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pzgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pzvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pzgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call zcopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call zdscal (n, temp1, v(1,j), 1)
call zdscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine zlascl |
c %-----------------------------------------%
c
call zlascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call zlascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call zcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call zcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pdznorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call MPI_ALLREDUCE( workl, h(1,j), j,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = dcmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call pdvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call pzvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call zaxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( cnorm_buf, cnorm, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pdznorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call pdvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %--------------------------------------------%
c
tst1 = dlapy2(dble(h(i,i)),dimag(h(i,i)))
& + dlapy2(dble(h(i+1,i+1)), dimag(h(i+1,i+1)))
if( tst1.eq.dble(zero) )
& tst1 = zlanhs( '1', k+np, h, ldh, workd(n+1) )
if( dlapy2(dble(h(i+1,i)),dimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pzmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pznaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/psnaitr.f 0000644 0001750 0001750 00000075654 12277373057 014326 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psnaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in psnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call psnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See psnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c psgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout Parallel ARPACK utility routine that prints vectors.
c slabad LAPACK routine that computes machine constants.
c pslamch ScaLAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c slanhs LAPACK routine that computes various norms of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naitr.F SID: 2.2
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in psnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Real
& rnorm_buf
c
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, psgetv0, slabad,
& psvout, psmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, slanhs, pslamch
external sdot, psnorm2, slanhs, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------%
c
unfl = pslamch(comm, 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | psgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call psgetv0 ( comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call MPI_ALLREDUCE( workl, h(1,j), j,
& MPI_REAL, MPI_SUM, comm, ierr)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call psvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_REAL, MPI_SUM, comm, ierr)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call saxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = sdot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
& MPI_REAL, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call psmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of psnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pslamch.f 0000644 0001750 0001750 00000005540 12277373057 014260 0000000 0000000 REAL FUNCTION PSLAMCH( ICTXT, CMACH )
*
include "mpif.h"
* -- ScaLAPACK auxilliary routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
CHARACTER CMACH
INTEGER ICTXT
* ..
*
* Purpose
* =======
*
* PSLAMCH determines single precision machine parameters.
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle in which the computation takes
* place.
*
* CMACH (global input) CHARACTER*1
* Specifies the value to be returned by PSLAMCH:
* = 'E' or 'e', PSLAMCH := eps
* = 'S' or 's , PSLAMCH := sfmin
* = 'B' or 'b', PSLAMCH := base
* = 'P' or 'p', PSLAMCH := eps*base
* = 'N' or 'n', PSLAMCH := t
* = 'R' or 'r', PSLAMCH := rnd
* = 'M' or 'm', PSLAMCH := emin
* = 'U' or 'u', PSLAMCH := rmin
* = 'L' or 'l', PSLAMCH := emax
* = 'O' or 'o', PSLAMCH := rmax
*
* where
*
* eps = relative machine precision
* sfmin = safe minimum, such that 1/sfmin does not overflow
* base = base of the machine
* prec = eps*base
* t = number of (base) digits in the mantissa
* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
* emin = minimum exponent before (gradual) underflow
* rmin = underflow threshold - base**(emin-1)
* emax = largest exponent before overflow
* rmax = overflow threshold - (base**emax)*(1-eps)
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER IDUMM
REAL TEMP, TEMP1
* ..
* .. External Subroutines ..
* EXTERNAL SGAMN2D, SGAMX2D
* ..
* .. External Functions ..
LOGICAL LSAME
REAL SLAMCH
EXTERNAL LSAME, SLAMCH
* ..
* .. Executable Statements ..
*
TEMP1 = SLAMCH( CMACH )
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL,
$ MPI_MAX, ICTXT, IDUMM )
* CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL MPI_ALLREDUCE( TEMP1, TEMP, 1, MPI_REAL,
$ MPI_MIN, ICTXT, IDUMM )
* CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
* $ IDUMM, 1, -1, IDUMM )
ELSE
TEMP = TEMP1
END IF
*
PSLAMCH = TEMP
*
* End of PSLAMCH
*
END
arpack-ng-3.1.5/PARPACK/SRC/MPI/pcneupd.f 0000644 0001750 0001750 00000104646 12277373057 014276 0000000 0000000 c\BeginDoc
c
c\Name: pcneupd
c
c Message Passing Layer: MPI
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PCNAUPD. PCNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of PCNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of PCNAUPD.
c
c\Usage:
c call pcneupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 PCNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to PCNAUPD 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, RWORK, INFO
c
c must be passed directly to CNEUPD following the last call
c to PCNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PCNAUPD and the call to CNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex 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 PCNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c PCNAUPD. They are not changed by PCNEUPD.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 PCNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 PCNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ctrsen.
c Re-enter subroutine pcneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ctrevc.
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: PCNAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c cgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c clacpy LAPACK matrix copy routine.
c clahqr LAPACK routine that computes the Schur form of a
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 ctrsen LAPACK routine that re-orders the Schur form.
c cunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c pslamch ScaLAPACK routine that determines machine constants.
c ctrmm Level 3 BLAS matrix times an upper triangular matrix.
c cgeru Level 2 BLAS rank one update to a matrix.
c ccopy Level 1 BLAS that copies one vector to another .
c cscal Level 1 BLAS that scales a vector.
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 complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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
c upper triangular matrix stored workl(ipntr(12)).
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: neupd.F SID: 2.2
c
c\SCCS Information:
c FILE: neupd.F SID: 1.9 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pcneupd
& ( comm , 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 | MPI Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex
& sigma
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Real
& rwork(ncv)
Complex
& d(nev) , resid(n) , v(ldv,ncv) ,
& z(ldz, nev), workd(3*n), workl(lworkl),
& workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift
Complex
& rnorm, temp, vl(1)
Real
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy ,cgeru,cgeqr2,clacpy,pcmout,
& cunm2r,ctrmm,pcvout,pivout,
& clahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2,pslamch,slapy2
external scnrm2,pslamch,slapy2
c
Complex
& cdotc
external cdotc
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pcvout(comm, logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values passed in from _NAUPD.')
call pcvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pcngets(comm, ishift, which ,
& nev , np , workl(irz),
& workl(bounds))
c
if (msglvl .gt. 2) then
call pcvout(comm,logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values after calling _NGETS.')
call pcvout(comm,logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 clahqr to compute the Schur form |
c | of the upper Hessenberg matrix returned by PCNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pcvout(comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
call pcvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pcmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
if (reord) then
c
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)
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pcvout (comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pcmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call ccopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call ccopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using cunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = scnrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = real(one) / rtemp
call csscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
call ccopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call pcvout(comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pcmout(comm, logfil, nconv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call ccopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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
end if
c
else
c
c %--------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PCNAUPD 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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pcvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call pcvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call pcvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call pcvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call cgeru(n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pcneupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdnaitr.f 0000644 0001750 0001750 00000076204 12277373057 014277 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdnaitr
c
c Message Passing Layer: MPI
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pdnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pdnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM MPI Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pdnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pdgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout Parallel ARPACK utility routine that prints vectors.
c dlabad LAPACK routine that computes machine constants.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naitr.F SID: 2.2
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pdnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
include 'mpif.h'
c
c %---------------%
c | MPI Variables |
c %---------------%
c
integer comm
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
Double precision
& rnorm_buf
c
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, pdgetv0, dlabad,
& pdvout, pdmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, dlanhs, pdlamch
external ddot, pdnorm2, dlanhs, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------%
c
unfl = pdlamch(comm, 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pdgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pdgetv0 ( comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, wnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call MPI_ALLREDUCE( workl, h(1,j), j,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call pdvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl(j+1), 1)
call MPI_ALLREDUCE( workl(j+1), workl(1), j,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr)
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call daxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm_buf = ddot (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( rnorm_buf, rnorm1, 1,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pdmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pdnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/MPI/pdlarnv.f 0000644 0001750 0001750 00000003722 12277373057 014277 0000000 0000000 c\BeginDoc
c
c\Name: pdlarnv
c
c Message Passing Layer: MPI
c
c\Description:
c
c Parallel Version of ARPACK utility routine dlarnv
c
c PSLARNV returns a vector of n (nloc) random real numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM MPI Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Double precision array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine dlarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine SLARNV to generate random
c real numbers from a uniform (0,1) distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.4 DATE OF SID: 04/16/99
c
c-----------------------------------------------------------------------
c
subroutine pdlarnv( comm, idist, iseed, n, x )
c
include 'mpif.h'
c
c .. MPI VARIABLES AND FUNCTIONS ..
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Double precision
& x( * )
c ..
c .. External Subroutines ..
external dlarnv
c ..
c .. Executable Statements ..
c
call dlarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/ 0000755 0001750 0001750 00000000000 12277671743 012740 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/SRC/BLACS/psneupd.f 0000644 0001750 0001750 00000126411 12277373057 014507 0000000 0000000 c\BeginDoc
c
c\Name: psneupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PSNAUPD. PSNAUPD 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 PSNAUPD 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 PSNAUPD.
c
c\Usage:
c call psneupd
c ( COMM, RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 PSNAUPD. A further computation must be performed by the user
c to transform the Ritz values computed for OP by PSNAUPD 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 PSNAUPD. 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 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 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
c **** The remaining arguments MUST be the same as for the ****
c **** call to PSNAUPD 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 PSNEUPD following the last call
c to PSNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSNAUPD and the call to PSNEUPD.
c
c Three of these parameters (V, WORKL, INFO) are also output parameters:
c
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 PSNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+3*ncv) contains information obtained in
c PSNAUPD. They are not changed by PSNEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 PSNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine slahqr
c could not be reordered by LAPACK routine strsen.
c Re-enter subroutine psneupd 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
c the same space. Please notify the authors if this error
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 = -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 slahqr.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine strevc.
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: PSNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: PSNEUPD got a different count of the number of converged
c Ritz values than PSNAUPD got. This indicates the user
c probably made an error in passing data from PSNAUPD to
c PSNEUPD or that the data was modified before entering
c PSNEUPD.
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout Parallel ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c slahqr LAPACK routine to compute the real Schur form of an
c upper Hessenberg matrix.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slaset LAPACK matrix initialization routine.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form.
c strsen LAPACK routine that re-orders the Schur form.
c strmm Level 3 BLAS matrix times an upper triangular matrix.
c sger Level 2 BLAS rank one update to a matrix.
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 PSNAUPD 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 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 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 quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neupd.F SID: 2.3
c
c\SCCS Information:
c FILE: neupd.F SID: 1.8 DATE OF SID: 04/10/01
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine psneupd
& (comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj
logical reord
Real
& conds , rnorm, sep , temp,
& vl(1,1), temp1, eps23
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy , sger , sgeqr2, slacpy,
& slahqr, slaset, psmout, sorm2r,
& strevc, strmm , strsen, sscal ,
& psvout, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2, pslamch
external slapy2, snrm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
c | The following is used and set by PSNEUPD. |
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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values passed in from _NAUPD.')
call psvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values passed in from _NAUPD.')
call psvout (comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 psngets(comm , ishift , which ,
& nev , np , workl(irr),
& workl(iri), workl(bounds),
& workl , workl(np+1))
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values after calling _NGETS.')
call psvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values after calling _NGETS.')
call psvout (comm, logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 PSNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call psvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
call psvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call psmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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 )
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
call psvout(comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call psmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call scopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
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)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
c | * Postmultiply V by Q using sorm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | strevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = snrm2( ncv, workl(invsub+(j-1)*ldq), 1 )
call sscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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)
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call sgemv('T' , ncv , nconv,
& one , workl(invsub), ldq ,
& workl(ihbds), 1 , zero ,
& workev , 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = slapy2(workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call psmout(comm, logfil, ncv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call scopy(nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call strmm('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PSNAUPD 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)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call sscal(ncv, rnorm, workl(ihbds), 1)
do 50 k=1, ncv
temp = slapy2(workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
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
& + sigmar
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)
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)
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
call psvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
call psvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
call psvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
call psvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheigr+j-1)
else if (iconj .eq. 0) then
temp = slapy2( 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) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
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)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of PSNEUPD |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pssaup2.f 0000644 0001750 0001750 00000100640 12277373057 014422 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by pssaupd.
c
c\Usage:
c call pssaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pssaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pssaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the second column
c of H starting at H(1,2). If pssaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Real array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Real work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in pssaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c psgetv0 Parallel ARPACK initial vector generation routine.
c pssaitr Parallel ARPACK Lanczos factorization routine.
c pssapps Parallel ARPACK application of implicit shifts routine.
c ssconv ARPACK convergence of Ritz values routine.
c psseigt Parallel ARPACK compute Ritz values and error bounds routine.
c pssgets Parallel ARPACK reorder Ritz values and error bounds routine.
c ssortr ARPACK sorting routine.
c sstrqb ARPACK routine that computes all eigenvalues and the
c last component of the eigenvectors of a symmetric
c tridiagonal matrix using the implicit QL or QR method.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saup2.F SID: 2.4
c
c\SCCS Information:
c FILE: saup2.F SID: 1.5 DATE OF SID: 05/20/98
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d
c
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Real
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, psgetv0, pssaitr, sscal, ssconv,
& psseigt, pssgets, pssapps,
& ssortr, psvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, pslamch
external sdot, psnorm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0/3.0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %---------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %---------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call psgetv0 ( comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call pssaitr (comm, ido, bmat, n, 0, nev0, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pssaitr was unable to build an Lanczos factorization|
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pssaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pssaitr was unable to build an Lanczos factorization|
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call psseigt ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call pssgets ( comm, ishift, which, nev, np, ritz,
& bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(np+1), 1)
call ssconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call psvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call ssortr (wprime, .true., kplusp, ritz, bounds)
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call ssortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call ssortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call ssortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pssgets ( comm, ishift, which, nev, np,
& ritz, bounds, workl)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_saup2: NEV and NP .')
call psvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call psvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, pssgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call scopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call psvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call psvout (comm, logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After pssapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call pssapps ( comm, n, nev, np, ritz, v, ldv, h, ldh, resid,
& q, ldq, 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 pssaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call psvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call psvout (comm, logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %----------------%
c | End of pssaup2 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdneigh.f 0000644 0001750 0001750 00000025012 12277373057 014442 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdneigh
c
c Message Passing Layer: BLACS
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 pdneigh
c ( COMM, RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RNORM Double precision 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 Double precision 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 RITZR, Double precision arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Double precision 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 Double precision 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 IERR Integer. (OUTPUT)
c Error exit flag from dlaqrb or dtrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dlaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c dmout ARPACK utility routine that prints matrices
c dvout ARPACK utility routine that prints vectors.
c dlacpy LAPACK matrix copy routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dtrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neigh.F SID: 2.2
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdneigh ( comm, rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Double precision
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dlacpy, dlaqrb, dtrevc, pdvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2, dnrm2
external dlapy2, dnrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call pdmout (comm, 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 | dlaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call dlacpy ('All', n, n, h, ldh, workl, n)
call dlaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call pdvout (comm, 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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call dtrevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | dtrevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = dnrm2( n, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = dlapy2( dnrm2( n, q(1,i), 1 ),
& dnrm2( n, q(1,i+1), 1 ) )
call dscal ( n, one / temp, q(1,i), 1 )
call dscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call dgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * dlapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call pdvout (comm, logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call pdvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdznorm2.f 0000644 0001750 0001750 00000003530 12277373057 014600 0000000 0000000 c\BeginDoc
c
c\Name: pdznorm2
c
c Message Passing Layer: BLACS
c
c\Description:
c
c\Usage:
c call pdznorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 3/6/96
c
c-----------------------------------------------------------------------
c
Double precision function pdznorm2 ( comm, n, x, inc )
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d, dgamx2d
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
External dznrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pdznorm2 = dznrm2( n, x, inc)
c
max = pdznorm2
call dgamx2d( comm, 'All', ' ', 1, 1, max, 1, ra, ca,
& -1, -1, -1 )
if ( max .eq. zero ) then
pdznorm2 = zero
else
pdznorm2 = (pdznorm2/max)**2.0
call dgsum2d( comm, 'All', ' ', 1, 1, pdznorm2, 1, -1, -1 )
pdznorm2 = max * sqrt(abs(pdznorm2))
endif
c
c %-----------------%
c | End of pdznorm2 |
c %-----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/stat.h 0000644 0001750 0001750 00000001713 12277373057 014003 0000000 0000000 c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
c\SCCS Information: @(#)
c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
c
real t0, t1, t2, t3, t4, t5
save t0, t1, t2, t3, t4, t5
c
integer nopx, nbx, nrorth, nitref, nrstrt
real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
common /timing/
& nopx, nbx, nrorth, nitref, nrstrt,
& tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdngets.f 0000644 0001750 0001750 00000020272 12277373057 014473 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdngets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pdngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Double precision array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortc ARPACK sorting routine.
c dcopy Level 1 BLAS that copies one vector to another .
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ngets.F SID: 2.2
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdngets
& ( comm, ishift, which, kev, np, ritzr, ritzi,
& bounds, shiftr, shifti )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dsortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call dsortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call dsortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call dsortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call dsortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call dsortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine pdnapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pdvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call pdvout (comm, logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pdngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdseigt.f 0000644 0001750 0001750 00000013073 12277373057 014467 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdseigt
c
c Message Passing Layer: BLACS
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call pdseigt
c ( COMM, RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RNORM Double precision scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Double precision N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Double precision array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Double precision array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Double precision work array of length 3*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 dstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seigt.F SID: 2.2
c
c\SCCS Information:
c FILE: seigt.F SID: 1.3 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdseigt
& ( comm, rnorm, n, h, ldh, eig, bounds, workl, ierr )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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, ldh, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, dstqrb, pdvout, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call pdvout (comm, logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
c
call dcopy (n, h(1,2), 1, eig, 1)
call dcopy (n-1, h(2,1), 1, workl, 1)
call dstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %-----------------%
c | End of pdseigt |
c %-----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pssaitr.f 0000644 0001750 0001750 00000076165 12277373057 014530 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pssaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pssaitr
c ( COMM, IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See pssaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c psgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c psmout Parallel ARPACK utility routine that prints matrices.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saitr.F SID: 2.3
c
c\SCCS Information:
c FILE: saitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pssaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaitr
& (comm, ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Real
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, psgetv0, psvout, psmout,
& slascl, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, pslamch
external sdot, psnorm2, pslamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = pslamch(comm,'safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | psgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call psgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
wnorm = sdot (n, resid, 1, workd(ivj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
wnorm = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call sgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workl(1), 1)
call sgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
else if (mode .eq. 2) then
call sgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workl(1), 1)
call sgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv('N', n, j, -one, v, ldv, workl(1), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workl(j)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call sgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workl(j)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm1, 1, -1, -1 )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call sscal(n, -one, v(1,j+1), 1)
else
call sscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call psvout (comm, logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pssaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdseupd.f 0000644 0001750 0001750 00000103601 12277373057 014471 0000000 0000000 c\BeginDoc
c
c\Name: pdseupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 PSSAUPD for the linear operator OP prescribed by the MODE selection
c (see IPARAM(7) in PSSAUPD documentation.) PSSAUPD 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 PSSAUPD 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
c call pdseupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as workspace.
c
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 pdsaupd 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 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 PSSAUPD.
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 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 PDNAUPD 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 PSSEUPD following the last call
c to PSSAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSSAUPD and the call to PSSEUPD.
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(1:4*ncv) contains information obtained in
c PSSAUPD. They are not changed by PSSEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSSEUPD.
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 PSSEUPD if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 = -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: PSSAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 corresponding permutation to a matrix A.
c dsortr dsortr ARPACK sorting routine.
c pdnorm2 Parallel ARPACK routine that computes the 2-norm of a vector.
c pivout Parallel ARPACK utility routine that prints integers.
c pdvout Parallel 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 pdlamch ScaLAPACK 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 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 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
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seupd.F SID: 2.4
c
c\SCCS Information:
c FILE: seupd.F SID: 1.11 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pdseupd
& (comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
parameter (one = 1.0, zero = 0.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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Double precision
& bnorm2, rnorm, temp, temp1, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy , dger , dgeqr2, dlacpy, dorm2r, dscal,
& dsesrt, dsteqr, dswap , pdvout, pivout, dsortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdnorm2, pdlamch
external pdnorm2, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | pdsaupd 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 pdsaupd and is not |
c | modified by pdseupd. |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
c | The following is used and set by pdseupd. |
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | 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 pdseupd. |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.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 pdsaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
bnorm2 = pdnorm2(comm, n, workd, 1)
end if
c
if (msglvl .gt. 2) then
call pdvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values passed in from _SAUPD.')
call pdvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_seupd: Ritz estimates passed in from _SAUPD.')
end if
if (rvec) then
c
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(irz). Move |
c | the corresponding error estimates |
c | in workl(bound) accordingly. |
c %-------------------------------------%
c
np = ncv - nev
ishift = 0
call pdsgets(comm , ishift, which ,
& nev , np , workl(irz),
& workl(bounds), workl)
c
if (msglvl .gt. 2) then
call pdvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values after calling _SGETS.')
call pdvout(comm, logfil, ncv, workl(bounds), ndigit,
& '_seupd: Ritz value indices after calling _SGETS.')
end if
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, 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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
& '_neupd: 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 dcopy (ncv-1, workl(ih+1) , 1, workl(ihb), 1)
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call dcopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
call pdvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
call pdvout (comm, logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if (.not.select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
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,
& workl(iw), 1)
call dcopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call dcopy(ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
30 end if
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call dcopy(nconv, workl(ihd), 1, d, 1)
c
else
c
c %-----------------------------------------------------%
c | Ritz vectors not required. Load Ritz values into D. |
c %-----------------------------------------------------%
c
call dcopy(nconv, workl(ritz), 1, d, 1)
call dcopy(ncv, workl(ritz), 1, workl(ihd), 1)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
c | bounds. Not necessary if only Ritz values are desired. |
c %---------------------------------------------------------%
c
if (rvec) then
call dsesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 pdsaupd. |
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)
if (type .eq. 'SHIFTI') then
do 40 k=1, ncv
workl(ihd+k-1) = one / workl(ihd+k-1) + sigma
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
call dcopy (nconv, workl(ihd), 1, d, 1)
call dsortr('LA', .true., nconv, workl(ihd), workl(iw))
if (rvec) then
call dsesrt('LA', rvec , nconv, d, ncv, workl(iq), ldq)
else
call dcopy(ncv, workl(bounds), 1, workl(ihb), 1)
call dscal(ncv, bnorm2/rnorm, workl(ihb), 1)
call dsortr('LA', .true., nconv, d, workl(ihb))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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 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 %-----------------------------------------------------%
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 )
c
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 pdsaupd. |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
call pdvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
call pdvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
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)
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)
120 continue
c
end if
c
if (type .ne. 'REGULR')
& call dger(n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %----------------%
c | End of pdseupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pznaupd.f 0000644 0001750 0001750 00000067617 12277373057 014526 0000000 0000000 c\BeginDoc
c
c\Name: pznaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then dsaupd or dnaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pznaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pznaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pznaupd . 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 pznaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 = pdlamch (comm, 'EPS') (machine precision as computed
c by the ScaLAPACK auxiliary subroutine pdlamch ).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below)
c
c V Complex*16 array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of pznaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by pzneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 zneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c WORKD Complex*16 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex*16 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Double precision work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 = -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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine pzneupd .
c
c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call pzneupd immediately following
c completion of pznaupd . This is new starting with release 2 of ARPACK.
c
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 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
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 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex*16 resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex*16 resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pznaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c zstatn ARPACK routine that initializes the timing variables.
c pivout Parallel ARPACK utility routine that prints integers.
c pzvout Parallel ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, rwork, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex*16
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Double precision
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pznaup2 , pzvout , pivout, arscnd, zstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call zstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0 ) tol = pdlamch (comm, 'EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine pzneigh called |
c | by pznaup2 . Subroutine pzneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pznaup2
& ( comm, 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pznaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pzvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call pzvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pznaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psnorm2.f 0000644 0001750 0001750 00000003436 12277373057 014432 0000000 0000000 c\BeginDoc
c
c\Name: psnorm2
c
c Message Passing Layer: BLACS
c
c\Description:
c
c\Usage:
c call psnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 2/22/96
c
c-----------------------------------------------------------------------
c
Real function psnorm2 ( comm, n, x, inc )
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d, sgamx2d
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& snrm2
External snrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
psnorm2 = snrm2( n, x, inc)
c
max = psnorm2
call sgamx2d( comm, 'All', ' ', 1, 1, max, 1, ra, ca,
& -1, -1, -1 )
if ( max .eq. zero ) then
psnorm2 = zero
else
psnorm2 = (psnorm2/max)**2.0
call sgsum2d( comm, 'All', ' ', 1, 1, psnorm2, 1, -1, -1 )
psnorm2 = max * sqrt(abs(psnorm2))
endif
c
c %----------------%
c | End of psnorm2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/debug.h 0000644 0001750 0001750 00000001351 12277373057 014114 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcnaupd.f 0000644 0001750 0001750 00000067425 12277373057 014474 0000000 0000000 c\BeginDoc
c
c\Name: pcnaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This is intended to be used to find a few eigenpairs of a
c complex linear operator OP with respect to a semi-inner product defined
c by a hermitian positive semi-definite real matrix B. B may be the identity
c matrix. NOTE: if both OP and B are real, then ssaupd or snaupd should
c be used.
c
c
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pcnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> 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.
c
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pcnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pcnaupd. 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 pcnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = M * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute and return the shifts in the first
c NP locations of WORKL.
c IDO = 99: done
c -------------------------------------------------------------
c After the initialization phase, when the routine is used in
c the "shift-and-invert" mode, the vector M * X is already
c available and does not need to be recomputed in forming OP*X.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 = pslamch(comm, 'EPS') (machine precision as computed
c by the ScaLAPACK auxiliary subroutine pslamch).
c
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 1 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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. (See remark 4 below)
c
c V Complex array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to filter out
c the components of the unwanted eigenvector.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are to be provided by the user via
c reverse communication. The NCV eigenvalues of
c the Hessenberg matrix H are returned in the part
c of WORKL array corresponding to RITZ.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration from the beginning
c after updating the starting vector with a linear
c combination of Ritz vectors associated with the
c "wanted" eigenvalues.
c ISHIFT = 2: other choice of internal shift to be defined.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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; See under \Description of pcnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), _naupd returns NP, the number
c of shifts the user is to provide. 0 < NP < NCV-NEV.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg
c matrix H in WORKL.
c IPNTR(6): pointer to the ritz value array RITZ
c IPNTR(7): pointer to the (projected) ritz vector array Q
c IPNTR(8): pointer to the error BOUNDS array in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by pcneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not Used
c IPNTR(11): pointer to the NCV corresponding error bounds.
c IPNTR(12): pointer to the NCV by NCV upper 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 cneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c WORKD Complex 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 !!!!!!!!!!
c See Data Distribution Note below.
c
c WORKL Complex 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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 5*NCV.
c
c RWORK Real work array of length NCV (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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 = -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
c check actual array dimensions and layout.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when using
c Mode = 3. When operating in Mode = 3 setting WHICH = 'LM' will
c compute the NEV eigenvalues of the original problem that are
c closest to the shift SIGMA . After convergence, approximate eigenvalues
c of the original problem may be obtained with the ARPACK subroutine pcneupd.
c
c 2. If a basis for the invariant subspace corresponding to the converged Ritz
c values is needed, the user must call pcneupd immediately following
c completion of pcnaupd. This is new starting with release 2 of ARPACK.
c
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 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
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 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) complex shifts in locations
c WORKL(IPNTR(14)), WORKL(IPNTR(14)+1), ... , WORKL(IPNTR(14)+NP).
c Eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are ordered
c according to the order defined by WHICH. The associated Ritz estimates
c are located in WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... ,
c WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Complex resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Complex resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "_Complex_ Shift and Invert Strategies for
c _Real_ Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pcnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c cstatn ARPACK routine that initializes the timing variables.
c pivout Parallel ARPACK utility routine that prints integers.
c pcvout Parallel ARPACK utility routine that prints vectors.
c arscnd ARPACK utility routine for timing.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Dept. of Computational & Houston, Texas
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, rwork, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Complex
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
Real
& rwork(ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz, j
save bounds, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pcnaup2, pcvout, pivout, arscnd, cstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call cstatn
call arscnd (t0)
msglvl = mcaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 5*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 3) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. 0.0 ) tol = pslamch(comm, 'EpsMach')
if (ishift .ne. 0 .and.
& ishift .ne. 1 .and.
& ishift .ne. 2) ishift = 1
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 5*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := the ritz values |
c | workl(ncv*ncv+ncv+1:ncv*ncv+2*ncv) := error bounds |
c | workl(ncv*ncv+2*ncv+1:2*ncv*ncv+2*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+2*ncv+1:3*ncv*ncv+5*ncv) := workspace |
c | The final workspace is needed by subroutine pcneigh called |
c | by pcnaup2. Subroutine pcneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + ldh*ncv
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = iq
ipntr(8) = bounds
ipntr(14) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pcnaup2
& ( comm, 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, rwork, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pcnaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pcvout (comm, logfil, np, workl(ritz), ndigit,
& '_naupd: The final Ritz values')
call pcvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tcaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tcaupd, tcaup2, tcaitr, titref,
& tgetv0, tceigh, tcgets, tcapps, tcconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Complex implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pcnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pscnorm2.f 0000644 0001750 0001750 00000003461 12277373057 014573 0000000 0000000 c\BeginDoc
c
c\Name: pscnorm2
c
c Message Passing Layer: BLACS
c
c\Description:
c
c\Usage:
c call pscnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 3/6/96
c
c-----------------------------------------------------------------------
c
Real function pscnorm2 ( comm, n, x, inc )
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d, sgamx2d
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Real
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2
External scnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pscnorm2 = scnrm2( n, x, inc)
c
max = pscnorm2
call sgamx2d( comm, 'All', ' ', 1, 1, max, 1, ra, ca,
& -1, -1, -1 )
if ( max .eq. zero ) then
pscnorm2 = zero
else
pscnorm2 = (pscnorm2/max)**2.0
call sgsum2d( comm, 'All', ' ', 1, 1, pscnorm2, 1, -1, -1 )
pscnorm2 = max * sqrt(abs(pscnorm2))
endif
c
c %-----------------%
c | End of pscnorm2 |
c %-----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pzlarnv.f 0000644 0001750 0001750 00000003640 12277373057 014523 0000000 0000000 c\BeginDoc
c
c\Name: pzlarnv
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Parallel Version of ARPACK utility routine zlarnv
c
c PZLARNV returns a vector of n (nloc) random Complex*16 numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM BLACS Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Complex*16 array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine zlarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine CLARNV to generate random
c Complex*16 numbers from a uniform or normal distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.3 DATE OF SID: 04/17/99
c
c-----------------------------------------------------------------------
c
subroutine pzlarnv( comm, idist, iseed, n, x )
c
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Complex*16
& x( * )
c ..
c .. External Subroutines ..
external zlarnv
c ..
c .. Executable Statements ..
c
call zlarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdgetv0.f 0000644 0001750 0001750 00000033271 12277373057 014403 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdgetv0
c
c Message Passing Layer: BLACS
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pdgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pdgetv0 is called.
c It should be set to 1 on the initial call to pdgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Double precision N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Double precision work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine for vector output.
c pdlarnv Parallel wrapper for LAPACK routine dlarnv (generates a random vector).
c dgemv Level 2 BLAS routine for matrix vector multiplication.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: getv0.F SID: 2.3
c
c\SCCS Information:
c FILE: getv0.F SID: 1.4 DATE OF SID: 3/19/97
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Double precision
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdlarnv, pdvout, dcopy, dgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2
external ddot, pdnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pdlarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call dcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm0 = ddot (n, resid, 1, workd, 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm0, 1, -1, -1 )
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = pdnorm2( comm, n, resid, 1 )
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call dgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workl, 1)
call dgsum2d( comm, 'All', ' ', j-1, 1, workl, j, -1, -1 )
call dgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pdvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pclarnv.f 0000644 0001750 0001750 00000003624 12277373057 014476 0000000 0000000 c\BeginDoc
c
c\Name: pclarnv
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Parallel Version of ARPACK utility routine clarnv
c
c PCLARNV returns a vector of n (nloc) random Complex numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM BLACS Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Complex array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine clarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine CLARNV to generate random
c Complex numbers from a uniform or normal distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.3 DATE OF SID: 04/17/99
c
c-----------------------------------------------------------------------
c
subroutine pclarnv( comm, idist, iseed, n, x )
c
integer comm
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Complex
& x( * )
c ..
c .. External Subroutines ..
external clarnv
c ..
c .. Executable Statements ..
c
call clarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/Makefile.am 0000644 0001750 0001750 00000001336 12277373057 014714 0000000 0000000 noinst_LTLIBRARIES = libparpacksrc.la
libparpacksrc_la_SOURCES = \
pcgetv0.f pdlamch.f pdsaitr.f pslamch.f pssaitr.f pznapps.f \
pclarnv.f pdlarnv.f pdsapps.f pslarnv.f pssapps.f pznaup2.f \
pcnaitr.f pdnaitr.f pdsaup2.f psnaitr.f pssaup2.f pznaupd.f \
pcnapps.f pdnapps.f pdsaupd.f psnapps.f pssaupd.f pzneigh.f \
pcnaup2.f pdnaup2.f pdseigt.f psnaup2.f psseigt.f pzneupd.f \
pcnaupd.f pdnaupd.f pdseupd.f psnaupd.f psseupd.f pzngets.f \
pcneigh.f pdneigh.f pdsgets.f psneigh.f pssgets.f \
pcneupd.f pdneupd.f pdznorm2.f psneupd.f pzgetv0.f \
pcngets.f pdngets.f pscnorm2.f psngets.f pzlarnv.f \
pdgetv0.f pdnorm2.f psgetv0.f psnorm2.f pznaitr.f
EXTRA_DIST = debug.h stat.h
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdsaup2.f 0000644 0001750 0001750 00000101060 12277373057 014400 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by pdsaupd.
c
c\Usage:
c call pdsaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL,
c IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pdsaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pdsaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi/Lanczos iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Tridiagonal matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (NEV+NP) by 2 array. (OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c The subdiagonal is stored in the first column of H starting
c at H(2,1). The main diagonal is stored in the second column
c of H starting at H(1,2). If pdsaup2 converges store the
c B-norm of the final residual vector in H(1,1).
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RITZ Double precision array of length NEV+NP. (OUTPUT)
c RITZ(1:NEV) contains the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to RITZ.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision array of length at least 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in the computation of the
c tridiagonal eigenvalue problem, the calculation and
c application of the shifts and convergence checking.
c If ISHIFT .EQ. O and IDO .EQ. 3, the first NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
c IPNTR(3): pointer to the vector B * X when used in one of
c the spectral transformation modes. X is the current
c operand.
c -------------------------------------------------------------
c
c WORKD Double precision work array of length 3*N. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Lanczos iteration
c for reverse communication. The user should not use WORKD
c as temporary workspace during the iteration !!!!!!!!!!
c See Data Distribution Note in pdsaupd.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: All possible eigenvalues of OP has been found.
c NP returns the size of the invariant subspace
c spanning the operator OP.
c = 2: No shifts could be applied.
c = -8: Error return from trid. eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Lanczos factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Routines called:
c pdgetv0 Parallel ARPACK initial vector generation routine.
c pdsaitr Parallel ARPACK Lanczos factorization routine.
c pdsapps Parallel ARPACK application of implicit shifts routine.
c dsconv ARPACK convergence of Ritz values routine.
c pdseigt Parallel ARPACK compute Ritz values and error bounds routine.
c pdsgets Parallel ARPACK reorder Ritz values and error bounds routine.
c dsortr ARPACK sorting routine.
c sstrqb ARPACK routine that computes all eigenvalues and the
c last component of the eigenvectors of a symmetric
c tridiagonal matrix using the implicit QL or QR method.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
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 pdnorm2 Parallel version of 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 two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saup2.F SID: 2.4
c
c\SCCS Information:
c FILE: saup2.F SID: 1.5 DATE OF SID: 05/20/98
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritz, bounds,
& q, ldq, workl, ipntr, workd, info )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d
c
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
character bmat*1, which*2
integer ido, info, ishift, iupd, ldh, ldq, ldv, mxiter,
& n, mode, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& bounds(nev+np), h(ldh,2), q(ldq,nev+np), resid(n),
& ritz(nev+np), v(ldv,nev+np), workd(3*n),
& workl(3*(nev+np))
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
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, nevd2, nevm2, kp(3)
Double precision
& rnorm, temp, eps23
save cnorm, getv0, initv, update, ushift,
& iter, kplusp, msglvl, nconv, nev0, np0,
& rnorm, eps23
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy, pdgetv0, pdsaitr, dscal, dsconv,
& pdseigt, pdsgets, pdsapps,
& dsortr, pdvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, pdlamch
external ddot, pdnorm2, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaup2
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0/3.0)
c
c %-------------------------------------%
c | nev0 and np0 are integer variables |
c | hold the initial values of NEV & NP |
c %-------------------------------------%
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev0 + np0
nconv = 0
iter = 0
c
c %---------------------------------------------%
c | Set flags for computing the first NEV steps |
c | of the Lanczos factorization. |
c %---------------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pdgetv0 ( comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1200
end if
getv0 = .false.
ido = 0
end if
c
c %------------------------------------------------------------%
c | Back from reverse communication: continue with update step |
c %------------------------------------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Lanczos factorization |
c %----------------------------------------------------------%
c
call pdsaitr (comm, ido, bmat, n, 0, nev0, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pdsaitr was unable to build an Lanczos factorization|
c | of length NEV0. INFO is returned with the size of |
c | the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N LANCZOS I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Lanczos |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_saup2: **** Start of major iteration number ****')
end if
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_saup2: The length of the current Lanczos factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: Extend the Lanczos factorization by')
end if
c
c %------------------------------------------------------------%
c | Compute NP additional steps of the Lanczos factorization. |
c %------------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pdsaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
c
c %-----------------------------------------------------%
c | pdsaitr was unable to build an Lanczos factorization|
c | of length NEV0+NP0. INFO is returned with the size |
c | of the factorization built. Exit main loop. |
c %-----------------------------------------------------%
c
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: Current B-norm of residual for factorization')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current symmetric tridiagonal matrix. |
c %--------------------------------------------------------%
c
call pdseigt ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from _seigt. |
c %----------------------------------------------------%
c
call dcopy(kplusp, ritz, 1, workl(kplusp+1), 1)
call dcopy(kplusp, bounds, 1, workl(2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The selection is based on the requested number of |
c | eigenvalues instead of the current NEV and NP to |
c | prevent possible misconvergence. |
c | * Wanted Ritz values := RITZ(NP+1:NEV+NP) |
c | * Shifts := RITZ(1:NP) := WORKL(1:NP) |
c %---------------------------------------------------%
c
nev = nev0
np = np0
call pdsgets ( comm, ishift, which, nev, np, ritz,
& bounds, workl)
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(np+1), 1)
call dsconv (nev, ritz(np+1), workl(np+1), tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_saup2: NEV, NP, NCONV are')
call pdvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: The eigenvalues of H')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP since we don't want to |
c | swap overlapping locations. |
c %------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically decreasing |
c | order first then swap low end of the spectrum next |
c | to high end in appropriate locations. |
c | NOTE: when np < floor(nev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
wprime = 'SA'
call dsortr (wprime, .true., kplusp, ritz, bounds)
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)
end if
c
else
c
c %--------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the an order that |
c | is opposite to WHICH, and apply the resulting |
c | order to BOUNDS. The eigenvalues are sorted so |
c | that the wanted part are always within the first |
c | NEV locations. |
c %--------------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LA') wprime = 'SA'
if (which .eq. 'SA') wprime = 'LA'
c
call dsortr (wprime, .true., kplusp, ritz, bounds)
c
end if
c
c %--------------------------------------------------%
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
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
temp = max( eps23, abs(ritz(j)) )
bounds(j) = bounds(j)*temp
40 continue
c
c %--------------------------------------------------%
c | Sort the "converged" Ritz values again so that |
c | the "threshold" values and their associated Ritz |
c | estimates appear at the appropriate position in |
c | ritz and bound. |
c %--------------------------------------------------%
c
if (which .eq. 'BE') then
c
c %------------------------------------------------%
c | Sort the "converged" Ritz values in increasing |
c | order. The "threshold" values are in the |
c | middle. |
c %------------------------------------------------%
c
wprime = 'LA'
call dsortr(wprime, .true., nconv, ritz, bounds)
c
else
c
c %----------------------------------------------%
c | In LM, SM, LA, SA case, sort the "converged" |
c | Ritz values according to WHICH so that the |
c | "threshold" value appears at the front of |
c | ritz. |
c %----------------------------------------------%
call dsortr(which, .true., nconv, ritz, bounds)
c
end if
c
c %------------------------------------------%
c | Use h( 1,1 ) as storage to communicate |
c | rnorm to _seupd if needed |
c %------------------------------------------%
c
h(1,1) = rnorm
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, kplusp, ritz, ndigit,
& '_saup2: Sorted Ritz values.')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_saup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if (nconv .lt. nev .and. ishift .eq. 1) then
c
c %---------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the number |
c | of Ritz values and the shifts. |
c %---------------------------------------------------%
c
nevbef = nev
nev = nev + min (nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 2) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pdsgets ( comm, ishift, which, nev, np,
& ritz, bounds, workl)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_saup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_saup2: NEV and NP .')
call pdvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_saup2: "wanted" Ritz values.')
call pdvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_saup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-----------------------------------------------------%
c | User specified shifts: reverse communication to |
c | compute the shifts. They are returned in the first |
c | NP locations of WORKL. |
c %-----------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:NP) |
c %------------------------------------%
c
ushift = .false.
c
c
c %---------------------------------------------------------%
c | Move the NP shifts to the first NP locations of RITZ to |
c | free up WORKL. This is for the non-exact shift case; |
c | in the exact shift case, pdsgets already handles this. |
c %---------------------------------------------------------%
c
if (ishift .eq. 0) call dcopy (np, workl, 1, ritz, 1)
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_saup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, workl, ndigit,
& '_saup2: shifts selected')
if (ishift .eq. 1) then
call pdvout (comm, logfil, np, bounds, ndigit,
& '_saup2: corresponding Ritz estimates')
end if
end if
c
c %---------------------------------------------------------%
c | Apply the NP0 implicit shifts by QR bulge chasing. |
c | Each shift is applied to the entire tridiagonal matrix. |
c | The first 2*N locations of WORKD are used as workspace. |
c | After pdsapps is done, we have a Lanczos |
c | factorization of length NEV. |
c %---------------------------------------------------------%
c
call pdsapps ( comm, n, nev, np, ritz, v, ldv, h, ldh, resid,
& q, ldq, 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 pdsaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
130 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saup2: B-norm of residual for NEV factorization')
call pdvout (comm, logfil, nev, h(1,2), ndigit,
& '_saup2: main diagonal of compressed H matrix')
call pdvout (comm, logfil, nev-1, h(2,1), ndigit,
& '_saup2: subdiagonal of compressed H matrix')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error exit |
c %------------%
c
call arscnd (t1)
tsaup2 = t1 - t0
c
9000 continue
return
c
c %----------------%
c | End of pdsaup2 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pslarnv.f 0000644 0001750 0001750 00000003750 12277373057 014516 0000000 0000000 c\BeginDoc
c
c\Name: pslarnv
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Parallel Version of ARPACK utility routine slarnv
c
c PSLARNV returns a vector of n (nloc) random real numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM BLACS Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Real array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine slarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine SLARNV to generate random
c real numbers from a uniform (0,1) distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.4 DATE OF SID: 04/16/99
c
c-----------------------------------------------------------------------
c
subroutine pslarnv( comm, idist, iseed, n, x )
c
c .. BLACS VARIABLES AND FUNCTIONS ..
integer comm
c
c .. External Functions ..
external BLACS_GRIDINFO
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Real
& x( * )
c ..
c .. External Subroutines ..
external slarnv
c ..
c .. Executable Statements ..
c
call slarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdneupd.f 0000644 0001750 0001750 00000127061 12277373057 014472 0000000 0000000 c\BeginDoc
c
c\Name: pdneupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PDNAUPD . PDNAUPD 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 PDNAUPD 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 PDNAUPD .
c
c\Usage:
c call pdneupd
c ( COMM, RVEC, HOWMNY, SELECT, DR, DI, Z, LDZ, SIGMAR, SIGMAI,
c WORKEV, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute the Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
c If HOWMNY = 'S', SELECT specifies the Ritz vectors to be
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 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 PDNAUPD . A further computation must be performed by the user
c to transform the Ritz values computed for OP by PDNAUPD 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 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.
c
c NOTE: When Ritz values are complex, they will come in complex
c conjugate pairs. If eigenvectors are requested, the
c corresponding Ritz vectors will also come in conjugate
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 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
c A*z = lambda*B*z.
c
c The complex Ritz vector associated with the Ritz value
c with positive imaginary part is stored in two consecutive
c columns. The first column holds the real part of the Ritz
c vector and the second column holds the imaginary part. The
c Ritz vector associated with the Ritz value with negative
c imaginary part is simply the complex conjugate of the Ritz vector
c associated with the positive imaginary part.
c
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 PDNAUPD . 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 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 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
c **** The remaining arguments MUST be the same as for the ****
c **** call to PDNAUPD 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 PDNEUPD following the last call
c to PDNAUPD . These arguments MUST NOT BE MODIFIED between
c the the last call to PDNAUPD and the call to PDNEUPD .
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
c Upon INPUT: the NCV columns of V contain the Arnoldi basis
c vectors for OP as constructed by PDNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace. See Remark 2 below.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+3*ncv) contains information obtained in
c PDNAUPD . They are not changed by PDNEUPD .
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 pointers into WORKL for addresses
c of the above information computed by PDNEUPD .
c -------------------------------------------------------------
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 PDNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
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 pdneupd 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
c the same space. Please notify the authors if this error
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 = -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 = -9: Error return from calculation of eigenvectors.
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: PDNAUPD did not find any eigenvalues to sufficient
c accuracy.
c = -15: PDNEUPD got a different count of the number of converged
c Ritz values than PDNAUPD got. This indicates the user
c probably made an error in passing data from PDNAUPD to
c PDNEUPD or that the data was modified before entering
c PDNEUPD .
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout Parallel 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 upper Hessenberg matrix.
c pdlamch ScaLAPACK 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 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 dnrm2 Level 1 BLAS that computes the norm of a vector.
c dscal Level 1 BLAS that scales a vector.
c dcopy Level 1 BLAS that copies one vector to another .
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
c
c Let 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 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
c diagonal block is a complex conjugate pair of Ritz values. The real
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 PDNAUPD 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 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 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 quasi-triangular matrix of order IPARAM(5) is computed. See remark
c 2 above.
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neupd.F SID: 2.3
c
c\SCCS Information:
c FILE: neupd.F SID: 1.8 DATE OF SID: 04/10/01
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pdneupd
& (comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Double precision
& sigmar, sigmai, tol
c
c %-----------------%
c | Array Arguments |
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)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.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 , ldh , ldq ,
& mode , msglvl, outncv, ritzr ,
& ritzi , wri , wrr , irr ,
& iri , ibd , ishift, numcnv ,
& np , jj
logical reord
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 , pdmout , dorm2r ,
& dtrevc , dtrmm , dtrsen , dscal ,
& pdvout , pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dlapy2 , dnrm2 , pdlamch
external dlapy2 , dnrm2 , pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, min, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mneupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch (comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
c %--------------%
c | Quick return |
c %--------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 .and. sigmai .eq. zero) then
type = 'SHIFTI'
else if (mode .eq. 3 ) then
type = 'REALPT'
else if (mode .eq. 4 ) then
type = 'IMAGPT'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c %--------------------------------------------------------%
c
c %-----------------------------------------------------------%
c | The following is used and set by PDNEUPD . |
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 |
c | imaginary part of the Ritz values. |
c | workl(ncv*ncv+5*ncv+1:ncv*ncv+6*ncv) := The untransformed |
c | error bounds of the Ritz values |
c | workl(ncv*ncv+6*ncv+1:2*ncv*ncv+6*ncv) := Holds the upper |
c | quasi-triangular matrix for H |
c | workl(2*ncv*ncv+6*ncv+1: 3*ncv*ncv+6*ncv) := Holds the |
c | associated matrix representation of the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 6 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritzr = ipntr(6)
ritzi = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheigr = bounds + ldh
iheigi = iheigr + ldh
ihbds = iheigi + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheigr
ipntr(10) = iheigi
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wrr = 1
wri = ncv + 1
iwev = wri + ncv
c
c %-----------------------------------------%
c | irr points to the REAL part of the Ritz |
c | values computed by _neigh before |
c | exiting _naup2. |
c | iri points to the IMAGINARY part of the |
c | Ritz values computed by _neigh |
c | before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irr = ipntr(14)+ncv*ncv
iri = irr+ncv
ibd = iri+ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values passed in from _NAUPD.')
call pdvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values passed in from _NAUPD.')
call pdvout (comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pdngets (comm , ishift , which ,
& nev , np , workl(irr),
& workl(iri), workl(bounds),
& workl , workl(np+1))
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(irr), ndigit,
& '_neupd: Real part of Ritz values after calling _NGETS.')
call pdvout (comm, logfil, ncv, workl(iri), ndigit,
& '_neupd: Imag part of Ritz values after calling _NGETS.')
call pdvout (comm, logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 PDNAUPD . |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H')
call pdvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imaginary part of the Eigenvalues of H')
call pdvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper quasi-triangular matrix ')
end if
end if
c
if (reord) then
c
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 )
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(iheigr), ndigit,
& '_neupd: Real part of the eigenvalues of H--reordered')
call pdvout (comm, logfil, ncv, workl(iheigi), ndigit,
& '_neupd: Imag part of the eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Quasi-triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------%
c | Copy the last row of the Schur vector |
c | into workl(ihbds). This will be used |
c | to compute the Ritz estimates of |
c | converged Ritz values. |
c %---------------------------------------%
c
call dcopy (ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %----------------------------------------------------%
c | Place the computed eigenvalues of H into DR and DI |
c | if a spectral transformation was not used. |
c %----------------------------------------------------%
c
if (type .eq. 'REGULR') then
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %---------------------------------------------------------%
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheigr) and workl(iheigi) |
c | The first NCONV columns of V are now approximate Schur |
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 dlacpy ('All', n, nconv, v, ldv, z, ldz)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | quasi-triangular form of workl(iuptri,ldq) |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones |
c %---------------------------------------------------%
c
if (workl(invsub+(j-1)*ldq+j-1) .lt. zero) then
call dscal (nconv, -one, workl(iuptri+j-1), ldq)
call dscal (nconv, -one, workl(iuptri+(j-1)*ldq), 1)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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 | that the element of largest magnitude has |
c | magnitude 1; |
c %------------------------------------------------%
c
iconj = 0
do 40 j=1, nconv
c
if ( workl(iheigi+j-1) .eq. zero ) then
c
c %----------------------%
c | real eigenvalue case |
c %----------------------%
c
temp = dnrm2 ( ncv, workl(invsub+(j-1)*ldq), 1 )
call dscal ( ncv, one / temp,
& workl(invsub+(j-1)*ldq), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
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)
iconj = 1
else
iconj = 0
end if
c
end if
c
40 continue
c
call dgemv ('T' , ncv , nconv,
& one , workl(invsub), ldq ,
& workl(ihbds), 1 , zero ,
& workev , 1)
c
iconj = 0
do 45 j=1, nconv
if (workl(iheigi+j-1) .ne. zero) then
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
workev(j) = dlapy2 (workev(j), workev(j+1))
workev(j+1) = workev(j)
iconj = 1
else
iconj = 0
end if
end if
45 continue
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pdmout (comm, logfil, ncv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call dcopy (nconv, workev, 1, workl(ihbds), 1)
c
c %---------------------------------------------------------%
c | Compute the QR factorization of the eigenvector matrix |
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)
c
c %----------------------------------------------%
c | * Postmultiply Z by Q. |
c | * Postmultiply Z by R. |
c | The N by NCONV matrix Z is now contains the |
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)
c
call dtrmm ('Right' , 'Upper' , 'No transpose',
& 'Non-unit', n , nconv ,
& one , workl(invsub), ldq ,
& z , ldz)
c
end if
c
else
c
c %------------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PDNAUPD into DR and DI |
c %------------------------------------------------------%
c
call dcopy (nconv, workl(ritzr), 1, dr, 1)
call dcopy (nconv, workl(ritzi), 1, di, 1)
call dcopy (nconv, workl(ritzr), 1, workl(iheigr), 1)
call dcopy (nconv, workl(ritzi), 1, workl(iheigi), 1)
call dcopy (nconv, workl(bounds), 1, workl(ihbds), 1)
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
if (rvec)
& call dscal (ncv, rnorm, workl(ihbds), 1)
do 50 k=1, ncv
temp = dlapy2 (workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(ihbds+k-1) = abs( workl(ihbds+k-1) )
& / temp / temp
50 continue
c
else if (type .eq. 'REALPT') then
c
do 60 k=1, ncv
60 continue
c
else if (type .eq. 'IMAGPT') then
c
do 70 k=1, ncv
70 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | For TYPE = 'REALPT' or 'IMAGPT' the user must from |
c | Rayleigh quotients or a projection. See remark 3 above.|
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
c
do 80 k=1, ncv
temp = dlapy2 (workl(iheigr+k-1),
& workl(iheigi+k-1) )
workl(iheigr+k-1) = workl(iheigr+k-1) / temp / temp
& + sigmar
workl(iheigi+k-1) = -workl(iheigi+k-1) / temp / temp
& + sigmai
80 continue
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
else if (type .eq. 'REALPT' .or. type .eq. 'IMAGPT') then
c
call dcopy (nconv, workl(iheigr), 1, dr, 1)
call dcopy (nconv, workl(iheigi), 1, di, 1)
c
end if
c
if (type .eq. 'SHIFTI' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Untransformed real part of the Ritz valuess.')
call pdvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Untransformed imag part of the Ritz valuess.')
call pdvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of untransformed Ritz values.')
else if (type .eq. 'REGULR' .and. msglvl .gt. 1) then
call pdvout (comm, logfil, nconv, dr, ndigit,
& '_neupd: Real parts of converged Ritz values.')
call pdvout (comm, logfil, nconv, di, ndigit,
& '_neupd: Imag parts of converged Ritz values.')
call pdvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 2. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. Remember that when theta |
c | has nonzero imaginary part, the corresponding |
c | Ritz vector is stored across two columns of Z. |
c %------------------------------------------------%
c
iconj = 0
do 110 j=1, nconv
if (workl(iheigi+j-1) .eq. zero) then
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) )
workev(j) = ( workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigr+j-1) +
& workl(invsub+j*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
workev(j+1) = ( workl(invsub+j*ldq+ncv-1) *
& workl(iheigr+j-1) -
& workl(invsub+(j-1)*ldq+ncv-1) *
& workl(iheigi+j-1) ) / temp / temp
iconj = 1
else
iconj = 0
end if
110 continue
c
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call dger (n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of PDNEUPD |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psnaup2.f 0000644 0001750 0001750 00000076572 12277373057 014435 0000000 0000000 c\BeginDoc
c
c\Name: psnaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by psnaupd.
c
c\Usage:
c call psnaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in psnaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in psnaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Real N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (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 RITZR, Real arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Real array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Real (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from sneigh.
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Real 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c psgetv0 Parallel ARPACK initial vector generation routine.
c psnaitr Parallel ARPACK Arnoldi factorization routine.
c psnapps Parallel ARPACK application of implicit shifts routine.
c snconv ARPACK convergence of Ritz values routine.
c psneigh Parallel ARPACK compute Ritz values and error bounds routine.
c psngets Parallel ARPACK reorder Ritz values and error bounds routine.
c ssortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c sswap Level 1 BLAS that swaps two vectors.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Revision history:
c Starting Point: Serial Code FILE: naup2.F SID: 2.2
c
c\SCCS Information:
c FILE: naup2.F SID: 1.5 DATE OF SID: 06/01/00
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Real
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character wprime*2
logical cnorm , getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, numcnv,
& j
Real
& rnorm , temp , eps23
save cnorm , getv0, initv , update, ushift,
& rnorm , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , eps23 , numcnv
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, psgetv0, psnaitr, snconv,
& psneigh, psngets, psnapps,
& psvout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, slapy2, pslamch
external sdot, psnorm2, slapy2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call psgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call psnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 psnapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call psnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call psneigh ( comm, rnorm, kplusp, h, ldh, ritzr, ritzi,
& bounds, q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from psneigh. |
c %----------------------------------------------------%
c
call scopy(kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call scopy(kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call scopy(kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of psngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call psngets ( comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call scopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call snconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call pivout (comm, logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call psvout (comm, logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call psvout (comm, logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call psvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call svout(logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call svout(logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with sngets, we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in sngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call ssortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call ssortc(wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, slapy2(ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call ssortc(which, .true., nconv, ritzr, ritzi, bounds)
c
c
if (msglvl .gt. 1) then
call svout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call svout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call svout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call psngets(comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call psvout (comm, logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call psvout (comm, logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call psvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call scopy (np, workl, 1, ritzr, 1)
call scopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call psvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call psvout (comm, logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call psvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call psnapps (comm, n, nev, np, ritzr, ritzi, 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 psnaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call psmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of psnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psseupd.f 0000644 0001750 0001750 00000103425 12277373057 014514 0000000 0000000 c\BeginDoc
c
c\Name: psseupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) the corresponding approximate eigenvectors,
c
c (2) an orthonormal (Lanczos) basis for the associated approximate
c invariant subspace,
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c (Lanczos) basis is always computed. There is an additional storage cost
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 PSSAUPD for the linear operator OP prescribed by the MODE selection
c (see IPARAM(7) in PSSAUPD documentation.) PSSAUPD 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 PSSAUPD 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
c The approximate eigenvalues of the original problem are returned in
c ascending algebraic order. The user may elect to call this routine
c once for each desired Ritz vector and store it peripherally if desired.
c There is also the option of computing a selected set of these vectors
c with a single call.
c
c\Usage:
c call psseupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, BMAT, N, WHICH, NEV, TOL,
c RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether Ritz vectors corresponding to the Ritz value
c approximations to the eigenproblem A*z = lambda*B*z are computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors.
c
c HOWMNY Character*1 (INPUT)
c Specifies how many Ritz vectors are wanted and the form of Z
c the matrix of Ritz vectors. See remark 1 below.
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 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 used as workspace.
c
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
c the Ritz values of OP computed by pssaupd 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 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.
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 PSSAUPD.
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 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 PSNAUPD 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 PSSEUPD following the last call
c to PSSAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PSSAUPD and the call to PSSEUPD.
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(1:4*ncv) contains information obtained in
c PSSAUPD. They are not changed by PSSEUPD.
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 pointers into WORKL for addresses
c of the above information computed by PSSEUPD.
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 PSSEUPD if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c = -1: N must be positive.
c = -2: NEV must be positive.
c = -3: NCV must be greater than NEV and less than or equal to N.
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 ssteqr.
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: PSSAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
c
c\Remarks
c 1. The converged Ritz values are always returned in increasing
c (algebraic) order.
c
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 ssesrt ARPACK routine that sorts an array X, and applies the
c corresponding permutation to a matrix A.
c ssortr ssortr ARPACK sorting routine.
c psnorm2 Parallel ARPACK routine that computes the 2-norm of a vector.
c pivout Parallel ARPACK utility routine that prints integers.
c psvout Parallel ARPACK utility routine that prints vectors.
c sgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c slacpy LAPACK matrix copy routine.
c pslamch ScaLAPACK routine that determines machine constants.
c sorm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c ssteqr LAPACK routine that computes eigenvalues and eigenvectors
c of a tridiagonal matrix.
c sger Level 2 BLAS rank one update to a matrix.
c scopy Level 1 BLAS that copies one vector to another .
c sscal Level 1 BLAS that scales a vector.
c sswap Level 1 BLAS that swaps the contents of two vectors.
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seupd.F SID: 2.4
c
c\SCCS Information:
c FILE: seupd.F SID: 1.11 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine psseupd
& (comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Real
& sigma, tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(7), ipntr(11)
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
& one, zero
parameter (one = 1.0, zero = 0.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 , np , ishift,
& leftptr, rghtptr, numcnv, jj
Real
& bnorm2, rnorm, temp, temp1, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy , sger , sgeqr2, slacpy, sorm2r, sscal,
& ssesrt, ssteqr, sswap , psvout, pivout, ssortr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& psnorm2, pslamch
external psnorm2, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mseupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c %--------------%
c | Quick return |
c %--------------%
c
if (nconv .eq. 0) go to 9000
ierr = 0
c
if (nconv .le. 0) ierr = -14
if (n .le. 0) ierr = -1
if (nev .le. 0) ierr = -2
if (ncv .le. nev) ierr = -3
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec )
& ierr = -15
if (rvec .and. howmny .eq. 'S') ierr = -16
c
if (rvec .and. lworkl .lt. ncv**2+8*ncv) ierr = -7
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else if (mode .eq. 4 ) then
type = 'BUCKLE'
else if (mode .eq. 5 ) then
type = 'CAYLEY'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
if (nev .eq. 1 .and. which .eq. 'BE') ierr = -12
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
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 | pssaupd 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 pssaupd and is not |
c | modified by psseupd. |
c %-------------------------------------------------------%
c
c %-------------------------------------------------------%
c | The following is used and set by psseupd. |
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 |
c | Ritz values of the original system. The first |
c | NCONV spots have the wanted values. If MODE = |
c | 1 or 2 then will equal workl(2*ncv+1:3*ncv). |
c | workl(5*ncv+1:5*ncv+ncv) := used as workspace during |
c | computation of the eigenvectors of H. Stores |
c | the subdiagonal of H. Upon EXIT contains the |
c | NCV corresponding Ritz estimates of the |
c | original system. The first NCONV spots have the |
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 | ssteqr. 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 ssteqr and by psseupd. |
c | GRAND total of NCV*(NCV+8) locations. |
c %-------------------------------------------------------%
c
c
ih = ipntr(5)
ritz = ipntr(6)
bounds = ipntr(7)
ldh = ncv
ldq = ncv
ihd = bounds + ldh
ihb = ihd + ldh
iq = ihb + ldh
iw = iq + ldh*ncv
next = iw + 2*ncv
ipntr(4) = next
ipntr(8) = ihd
ipntr(9) = ihb
ipntr(10) = iq
c
c %----------------------------------------%
c | irz points to the Ritz values computed |
c | by _seigt before exiting _saup2. |
c | ibd points to the Ritz estimates |
c | computed by _seigt before exiting |
c | _saup2. |
c %----------------------------------------%
c
irz = ipntr(11)+ncv
ibd = irz+ncv
c
c
c %---------------------------------%
c | Set machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.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 pssaupd WORKD(1:N) has |
c | B*RESID(1:N). |
c %---------------------------------------%
c
rnorm = workl(ih)
if (bmat .eq. 'I') then
bnorm2 = rnorm
else if (bmat .eq. 'G') then
bnorm2 = psnorm2(comm, n, workd, 1)
end if
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values passed in from _SAUPD.')
call psvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_seupd: Ritz estimates passed in from _SAUPD.')
end if
if (rvec) then
c
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(irz). Move |
c | the corresponding error estimates |
c | in workl(bound) accordingly. |
c %-------------------------------------%
c
np = ncv - nev
ishift = 0
call pssgets(comm , ishift, which ,
& nev , np , workl(irz),
& workl(bounds), workl)
c
if (msglvl .gt. 2) then
call psvout(comm, logfil, ncv, workl(irz), ndigit,
& '_seupd: Ritz values after calling _SGETS.')
call psvout(comm, logfil, ncv, workl(bounds), ndigit,
& '_seupd: Ritz value indices after calling _SGETS.')
end if
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, 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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, logfil, 1, nconv, ndigit,
& '_neupd: 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)
c
call ssteqr('Identity', ncv , workl(ihd),
& workl(ihb), workl(iq), ldq ,
& workl(iw) , ierr)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call scopy (ncv, workl(iq+ncv-1), ldq, workl(iw), 1)
call psvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: NCV Ritz values of the final H matrix')
call psvout (comm, logfil, ncv, workl(iw), ndigit,
& '_seupd: last row of the eigenvector matrix for H')
end if
c
if (reord) then
c
c %---------------------------------------------%
c | Reordered the eigenvalues and eigenvectors |
c | computed by _steqr so that the "converged" |
c | eigenvalues appear in the first NCONV |
c | positions of workl(ihd), and the associated |
c | eigenvectors appear in the first NCONV |
c | columns. |
c %---------------------------------------------%
c
leftptr = 1
rghtptr = ncv
c
if (ncv .eq. 1) go to 30
c
20 if (select(leftptr)) then
c
c %-------------------------------------------%
c | Search, from the left, for the first Ritz |
c | value that has not converged. |
c %-------------------------------------------%
c
leftptr = leftptr + 1
c
else if (.not.select(rghtptr)) then
c
c %----------------------------------------------%
c | Search, from the right, the first Ritz value |
c | that has converged. |
c %----------------------------------------------%
c
rghtptr = rghtptr - 1
c
else
c
c %----------------------------------------------%
c | Swap the Ritz value on the left that has not |
c | converged with the Ritz value on the right |
c | that has converged. Swap the associated |
c | eigenvector of the tridiagonal matrix H as |
c | well. |
c %----------------------------------------------%
c
temp = workl(ihd+leftptr-1)
workl(ihd+leftptr-1) = workl(ihd+rghtptr-1)
workl(ihd+rghtptr-1) = temp
call scopy(ncv, workl(iq+ncv*(leftptr-1)), 1,
& workl(iw), 1)
call scopy(ncv, workl(iq+ncv*(rghtptr-1)), 1,
& workl(iq+ncv*(leftptr-1)), 1)
call scopy(ncv, workl(iw), 1,
& workl(iq+ncv*(rghtptr-1)), 1)
leftptr = leftptr + 1
rghtptr = rghtptr - 1
c
end if
c
if (leftptr .lt. rghtptr) go to 20
c
30 end if
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, ncv, workl(ihd), ndigit,
& '_seupd: The eigenvalues of H--reordered')
end if
c
c %----------------------------------------%
c | Load the converged Ritz values into D. |
c %----------------------------------------%
c
call scopy(nconv, workl(ihd), 1, d, 1)
c
else
c
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)
c
end if
c
c %------------------------------------------------------------------%
c | Transform the Ritz values and possibly vectors and corresponding |
c | Ritz estimates of OP to those of A*x=lambda*B*x. The Ritz values |
c | (and corresponding data) are returned in ascending order. |
c %------------------------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
c %---------------------------------------------------------%
c | Ascending sort of wanted Ritz values, vectors and error |
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)
else
call scopy(ncv, workl(bounds), 1, workl(ihb), 1)
end if
c
else
c
c %-------------------------------------------------------------%
c | * Make a copy of all the Ritz values. |
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
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 pssaupd. |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c | They are only reordered. |
c %-------------------------------------------------------------%
c
call scopy (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
40 continue
else if (type .eq. 'BUCKLE') then
do 50 k=1, ncv
workl(ihd+k-1) = sigma * workl(ihd+k-1) /
& (workl(ihd+k-1) - one)
50 continue
else if (type .eq. 'CAYLEY') then
do 60 k=1, ncv
workl(ihd+k-1) = sigma * (workl(ihd+k-1) + one) /
& (workl(ihd+k-1) - one)
60 continue
end if
c
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 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 | 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 | Ritz vector purification. |
c %-------------------------------------------------------------%
c
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)
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))
end if
c
end if
c
c %------------------------------------------------%
c | Compute the Ritz vectors. Transform the wanted |
c | eigenvectors of the symmetric tridiagonal H by |
c | the Lanczos basis matrix V. |
c %------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A') then
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q. |
c | * Copy the first NCONV columns of VQ into Z. |
c | The N by NCONV matrix Z is now a matrix representation |
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)
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 %-----------------------------------------------------%
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 )
c
else if (rvec .and. howmny .eq. 'S') then
c
c Not yet implemented. See remark 2 above.
c
end if
c
if (type .eq. 'REGULR' .and. rvec) then
c
do 70 j=1, ncv
workl(ihb+j-1) = rnorm * abs( workl(ihb+j-1) )
70 continue
c
else if (type .ne. 'REGULR' .and. rvec) then
c
c %-------------------------------------------------%
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 pssaupd. |
c | * Determine Ritz estimates of the lambda. |
c %-------------------------------------------------%
c
call sscal (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
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
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) )
100 continue
c
end if
c
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call psvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Untransformed converged Ritz values')
call psvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Ritz estimates of the untransformed Ritz values')
else if (msglvl .gt. 1) then
call psvout (comm, logfil, nconv, d, ndigit,
& '_seupd: Converged Ritz values')
call psvout (comm, logfil, nconv, workl(ihb), ndigit,
& '_seupd: Associated Ritz estimates')
end if
c
c %-------------------------------------------------%
c | Ritz vector purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3,4,5. See reference 7 |
c %-------------------------------------------------%
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)
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)
120 continue
c
end if
c
if (type .ne. 'REGULR')
& call sger(n, nconv, one, resid, 1, workl(iw), 1, z, ldz)
c
9000 continue
c
return
c
c %----------------%
c | End of psseupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psneigh.f 0000644 0001750 0001750 00000024606 12277373057 014471 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psneigh
c
c Message Passing Layer: BLACS
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 psneigh
c ( COMM, RNORM, N, H, LDH, RITZR, RITZI, BOUNDS, Q, LDQ, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
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 Real 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 RITZR, Real arrays of length N. (OUTPUT)
c RITZI On output, RITZR(1:N) (resp. RITZI(1:N)) contains the real
c (respectively imaginary) parts of the eigenvalues of H.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the Ritz estimates associated with
c the eigenvalues RITZR and RITZI. This is equal to RNORM
c times the last components of the eigenvectors corresponding
c to the eigenvalues in RITZR and RITZI.
c
c Q Real 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 Real 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 IERR Integer. (OUTPUT)
c Error exit flag from slaqrb or strevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c slaqrb ARPACK routine to compute the real Schur form of an
c upper Hessenberg matrix and last row of the Schur vectors.
c arscnd ARPACK utility routine for timing.
c smout ARPACK utility routine that prints matrices
c svout ARPACK utility routine that prints vectors.
c slacpy LAPACK matrix copy routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c strevc LAPACK routine to compute the eigenvectors of a matrix
c in upper quasi-triangular form
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another .
c snrm2 Level 1 BLAS that computes the norm of a vector.
c sscal Level 1 BLAS that scales a vector.
c
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: neigh.F SID: 2.2
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psneigh ( comm, rnorm, n, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ierr)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
Real
& bounds(n), h(ldh,n), q(ldq,n), ritzi(n), ritzr(n),
& workl(n*(n+3))
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer i, iconj, msglvl
Real
& temp, vl(1)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, slacpy, slaqrb, strevc, psvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& slapy2, snrm2
external slapy2, snrm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mneigh
c
if (msglvl .gt. 2) then
call psmout (comm, 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 | slaqrb returns the full Schur form of H in WORKL(1:N**2) |
c | and the last components of the Schur vectors in BOUNDS. |
c %-----------------------------------------------------------%
c
call slacpy ('All', n, n, h, ldh, workl, n)
call slaqrb (.true., n, 1, n, workl, n, ritzr, ritzi, bounds,
& ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call psvout (comm, 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 last components of the Schur vectors to get |
c | the last components of the corresponding eigenvectors. |
c | Remember that if the i-th and (i+1)-st eigenvalues are |
c | complex conjugate pairs, then the real & imaginary part |
c | of the eigenvector components are split across adjacent |
c | columns of Q. |
c %-----------------------------------------------------------%
c
call strevc ('R', 'A', select, n, workl, n, vl, n, q, ldq,
& n, n, workl(n*n+1), 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 | strevc 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
iconj = 0
do 10 i=1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
temp = snrm2( n, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i), 1 )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we further normalize by the |
c | square root of two. |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
temp = slapy2( snrm2( n, q(1,i), 1 ),
& snrm2( n, q(1,i+1), 1 ) )
call sscal ( n, one / temp, q(1,i), 1 )
call sscal ( n, one / temp, q(1,i+1), 1 )
iconj = 1
else
iconj = 0
end if
end if
10 continue
c
call sgemv ('T', n, n, one, q, ldq, bounds, 1, zero, workl, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, n, workl, ndigit,
& '_neigh: Last row of the eigenvector matrix for H')
end if
c
c %----------------------------%
c | Compute the Ritz estimates |
c %----------------------------%
c
iconj = 0
do 20 i = 1, n
if ( abs( ritzi(i) ) .le. zero ) then
c
c %----------------------%
c | Real eigenvalue case |
c %----------------------%
c
bounds(i) = rnorm * abs( workl(i) )
else
c
c %-------------------------------------------%
c | Complex conjugate pair case. Note that |
c | since the real and imaginary part of |
c | the eigenvector are stored in consecutive |
c | columns, we need to take the magnitude |
c | of the last components of the two vectors |
c %-------------------------------------------%
c
if (iconj .eq. 0) then
bounds(i) = rnorm * slapy2( workl(i), workl(i+1) )
bounds(i+1) = bounds(i)
iconj = 1
else
iconj = 0
end if
end if
20 continue
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, n, ritzr, ndigit,
& '_neigh: Real part of the eigenvalues of H')
call psvout (comm, logfil, n, ritzi, ndigit,
& '_neigh: Imaginary part of the eigenvalues of H')
call psvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd (t1)
tneigh = tneigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of psneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcnaitr.f 0000644 0001750 0001750 00000076505 12277373057 014501 0000000 0000000 c\BeginDoc
c
c\Name: pcnaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pcnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pcnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pcnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Complex work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pcgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c clanhs LAPACK routine that computes various norms of a matrix.
c clascl LAPACK routine for careful scaling of a matrix.
c slabad LAPACK routine for defining the underflow and overflow
c limits
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of
c two vectors.
c cscal Level 1 BLAS that scales a vector.
c csscal Level 1 BLAS that scales a complex vector by a real number.
c pscnorm2 Parallel version of Level 1 BLAS that computes the
c norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: naitr.F SID: 2.1
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pcnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external cgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rone, rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0, rzero = 0.0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cscal, cgemv, pcgetv0, slabad,
& csscal, pcvout, pcmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex
& cdotc
Real
& pslamch, pscnorm2, clanhs, slapy2
external cdotc, pscnorm2, clanhs, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------%
c
unfl = pslamch(comm, 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pcgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pcvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pcgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call ccopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call csscal (n, temp1, v(1,j), 1)
call csscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine clascl |
c %-----------------------------------------%
c
call clascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call clascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call ccopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call ccopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
call cgsum2d( comm, 'All', ' ', j, 1, h(1,j), j, -1, -1 )
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call psvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call pcvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call cgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call cgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call cgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call caxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pscnorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call psvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %--------------------------------------------%
c
tst1 = slapy2(real(h(i,i)),aimag(h(i,i)))
& + slapy2(real(h(i+1,i+1)), aimag(h(i+1,i+1)))
if( tst1.eq.real(zero) )
& tst1 = clanhs( '1', k+np, h, ldh, workd(n+1) )
if( slapy2(real(h(i+1,i)),aimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pcmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pcnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psngets.f 0000644 0001750 0001750 00000020212 12277373057 014504 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psngets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call psngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZR, RITZI, BOUNDS, SHIFTR, SHIFTI )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest real part.
c 'SR' -> want the KEV eigenvalues of smallest real part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT/OUTPUT)
c INPUT: KEV+NP is the size of the matrix H.
c OUTPUT: Possibly increases KEV by one to keep complex conjugate
c pairs together.
c
c NP Integer. (INPUT/OUTPUT)
c Number of implicit shifts to be computed.
c OUTPUT: Possibly decreases NP by one to keep complex conjugate
c pairs together.
c
c RITZR, Real array of length KEV+NP. (INPUT/OUTPUT)
c RITZI On INPUT, RITZR and RITZI contain the real and imaginary
c parts of the eigenvalues of H.
c On OUTPUT, RITZR and RITZI are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTR, SHIFTI *** USE deprecated as of version 2.1. ***
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortc ARPACK sorting routine.
c scopy Level 1 BLAS that copies one vector to another .
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ngets.F SID: 2.2
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c 1. xxxx
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psngets
& ( comm, ishift, which, kev, np, ritzr, ritzi,
& bounds, shiftr, shifti )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritzr(kev+np), ritzi(kev+np),
& shiftr(1), shifti(1)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, ssortc, arscnd
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mngets
c
c %----------------------------------------------------%
c | LM, SM, LR, SR, LI, SI case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c | We first do a pre-processing sort in order to keep |
c | complex conjugate pairs together |
c %----------------------------------------------------%
c
if (which .eq. 'LM') then
call ssortc ('LR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SM') then
call ssortc ('SR', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LR') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SR') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'LI') then
call ssortc ('LM', .true., kev+np, ritzr, ritzi, bounds)
else if (which .eq. 'SI') then
call ssortc ('SM', .true., kev+np, ritzr, ritzi, bounds)
end if
c
call ssortc (which, .true., kev+np, ritzr, ritzi, bounds)
c
c %-------------------------------------------------------%
c | Increase KEV by one if the ( ritzr(np),ritzi(np) ) |
c | = ( ritzr(np+1),-ritzi(np+1) ) and ritz(np) .ne. zero |
c | Accordingly decrease NP by one. In other words keep |
c | complex conjugate pairs together. |
c %-------------------------------------------------------%
c
if ( ( ritzr(np+1) - ritzr(np) ) .eq. zero
& .and. ( ritzi(np+1) + ritzi(np) ) .eq. zero ) then
np = np - 1
kev = kev + 1
end if
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when they shifts |
c | are applied in subroutine psnapps. |
c | Be careful and use 'SR' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call ssortc ( 'SR', .true., np, bounds, ritzr, ritzi )
end if
c
call arscnd (t1)
tngets = tngets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call psvout (comm, logfil, kev+np, ritzr, ndigit,
& '_ngets: Eigenvalues of current H matrix -- real part')
call psvout (comm, logfil, kev+np, ritzi, ndigit,
& '_ngets: Eigenvalues of current H matrix -- imag part')
call psvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of psngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcgetv0.f 0000644 0001750 0001750 00000034536 12277373057 014407 0000000 0000000 c\BeginDoc
c
c\Name: pcgetv0
c
c Message Passing Layer: BLACS
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pcgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pcgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pcgetv0 is called.
c It should be set to 1 on the initial call to pcgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Complex work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pcvout Parallel ARPACK utility routine that prints vectors.
c pclarnv Parallel wrapper for LAPACK routine clarnv (generates a random vector).
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c ccopy Level 1 BLAS that copies one vector to another.
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: getv0.F SID: 2.1
c
c\SCCS Information:
c FILE: getv0.F SID: 1.7 DATE OF SID: 04/12/01
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external cgsum2d, blacs_gridinfo
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) ,
& rzero = 0.0 )
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj, myid, igen
Real
& rnorm0
Complex
& cnorm, cnorm2
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, cgemv, pclarnv, pcvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pscnorm2, slapy2
Complex
& cdotc
external cdotc, pscnorm2, slapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
c
c %-----------------------------------%
c | Generate a seed on each processor |
c | using process id (myid). |
c | Note: the seed must be between 1 |
c | and 4095. iseed(4) must be odd. |
c %-----------------------------------%
c
call BLACS_GRIDINFO(comm, nprow, npcol, myprow, mypcol)
c
c %-------------------------------------------%
c | Convert a 2-D process id (myprow, mypcol) |
c | to a 1-D process id (myid). |
c %-------------------------------------------%
c
myid = npcol*myprow + mypcol + 1
igen = 1000 + 2*myid - 1
if (igen .gt. 4095) then
write(0,*) 'Error in p_getv0: seed exceeds 4095!'
end if
c
iseed(1) = igen/1000
igen = mod(igen,1000)
iseed(2) = igen/100
igen = mod(igen,100)
iseed(3) = igen/10
iseed(4) = mod(igen,10)
c
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pclarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call ccopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm0 = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pscnorm2( comm, n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett`s book, page 107 and in Gragg and Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call cgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workl, 1)
call cgsum2d( comm, 'All', ' ', j-1, 1, workl, j, -1, -1 )
call cgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5 ) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
cnorm2 = cmplx(rnorm,rzero)
call pcvout (comm, logfil, 1, cnorm2, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pcvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pcgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdnaup2.f 0000644 0001750 0001750 00000077144 12277373057 014412 0000000 0000000 c\BeginDoc
c
c\Name: pdnaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by pdnaupd .
c
c\Usage:
c call pdnaup2
c ( COMM, IDO, BMAT, N, WHICH, NEV, NP, TOL, RESID, MODE, IUPD,
c ISHIFT, MXITER, V, LDV, H, LDH, RITZR, RITZI, BOUNDS,
c Q, LDQ, WORKL, IPNTR, WORKD, INFO )
c
c\Arguments
c
c COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pdnaupd .
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pdnaupd .
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV for two reasons. The first, is
c to keep complex conjugate pairs of "wanted" Ritz values
c together. The second, is that a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
c IUPD Integer. (INPUT)
c IUPD .EQ. 0: use explicit restart instead implicit update.
c IUPD .NE. 0: use implicit update.
c
c V Double precision N by (NEV+NP) array. (INPUT/OUTPUT)
c The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (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 RITZR, Double precision arrays of length NEV+NP. (OUTPUT)
c RITZI RITZR(1:NEV) (resp. RITZI(1:NEV)) contains the real (resp.
c imaginary) part of the computed Ritz values of OP.
c
c BOUNDS Double precision array of length NEV+NP. (OUTPUT)
c BOUNDS(1:NEV) contain the error bounds corresponding to
c the computed Ritz values.
c
c Q Double precision (NEV+NP) by (NEV+NP) array. (WORKSPACE)
c Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length at least
c (NEV+NP)**2 + 3*(NEV+NP). (INPUT/WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end. It is used in shifts calculation, shifts
c application and convergence checking.
c
c On exit, the last 3*(NEV+NP) locations of WORKL contain
c the Ritz values (real,imaginary) and associated Ritz
c estimates of the current Hessenberg matrix. They are
c listed in the same order as returned from dneigh .
c
c If ISHIFT .EQ. O and IDO .EQ. 3, the first 2*NP locations
c of WORKL are used in reverse communication to hold the user
c supplied shifts.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 Double precision 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 DNAUPD.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pdgetv0 Parallel ARPACK initial vector generation routine.
c pdnaitr Parallel ARPACK Arnoldi factorization routine.
c pdnapps Parallel ARPACK application of implicit shifts routine.
c dnconv ARPACK convergence of Ritz values routine.
c pdneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pdngets Parallel ARPACK reorder Ritz values and error bounds routine.
c dsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c dswap Level 1 BLAS that swaps two vectors.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Revision history:
c Starting Point: Serial Code FILE: naup2.F SID: 2.2
c
c\SCCS Information:
c FILE: naup2.F SID: 1.5 DATE OF SID: 06/01/00
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaup2
& ( comm, ido, bmat, n, which, nev, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, h, ldh, ritzr, ritzi, bounds,
& q, ldq, workl, ipntr, workd, info )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
Double precision
& bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), resid(n),
& ritzi(nev+np), ritzr(nev+np), v(ldv,nev+np),
& workd(3*n), workl( (nev+np)*(nev+np+3) )
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character wprime*2
logical cnorm , getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, numcnv,
& j
Double precision
& rnorm , temp , eps23
save cnorm , getv0, initv , update, ushift,
& rnorm , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , eps23 , numcnv
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(4)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dcopy , pdgetv0 , pdnaitr , dnconv ,
& pdneigh , pdngets , pdnapps ,
& pdvout , pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot , pdnorm2 , dlapy2 , pdlamch
external ddot , pdnorm2 , dlapy2 , pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic min, max, abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mnaup2
c
c %-------------------------------------%
c | Get the machine dependent constant. |
c %-------------------------------------%
c
eps23 = pdlamch (comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0 )
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvlues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pdgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. zero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pdnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv, h, ldh, ipntr,
& workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pdnapps . |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pdnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c %---------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP and possibly B |
c %---------------------------------------------------%
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pdneigh ( comm, rnorm, kplusp, h, ldh, ritzr, ritzi,
& bounds, q, ldq, workl, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %----------------------------------------------------%
c | Make a copy of eigenvalues and corresponding error |
c | bounds obtained from pdneigh . |
c %----------------------------------------------------%
c
call dcopy (kplusp, ritzr, 1, workl(kplusp**2+1), 1)
call dcopy (kplusp, ritzi, 1, workl(kplusp**2+kplusp+1), 1)
call dcopy (kplusp, bounds, 1, workl(kplusp**2+2*kplusp+1), 1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZR, |
c | RITZI and BOUNDS respectively. The variables NEV |
c | and NP may be updated if the NEV-th wanted Ritz |
c | value has a non zero imaginary part. In this case |
c | NEV is increased by one and NP decreased by one. |
c | NOTE: The last two arguments of pdngets are no |
c | longer used as of version 2.1. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
numcnv = nev
call pdngets ( comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
if (nev .eq. nev0+1) numcnv = nev0+1
c
c %-------------------%
c | Convergence test. |
c %-------------------%
c
call dcopy (nev, bounds(np+1), 1, workl(2*np+1), 1)
call dnconv (nev, ritzr(np+1), ritzi(np+1), workl(2*np+1),
& tol, nconv)
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = numcnv
kp(4) = nconv
call pivout (comm, logfil, 4, kp, ndigit,
& '_naup2: NEV, NP, NUMCNV, NCONV are')
call pdvout (comm, logfil, kplusp, ritzr, ndigit,
& '_naup2: Real part of the eigenvalues of H')
call pdvout (comm, logfil, kplusp, ritzi, ndigit,
& '_naup2: Imaginary part of the eigenvalues of H')
call pdvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. numcnv) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call dvout (logfil, kplusp, workl(kplusp**2+1), ndigit,
& '_naup2: Real part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp+1),
& ndigit,
& '_naup2: Imag part of the eig computed by _neigh:')
call dvout (logfil, kplusp, workl(kplusp**2+kplusp*2+1),
& ndigit,
& '_naup2: Ritz estimates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to _neupd if needed |
c %------------------------------------------%
h(3,1) = rnorm
c
c %----------------------------------------------%
c | To be consistent with dngets , we first do a |
c | pre-processing sort in order to keep complex |
c | conjugate pairs together. This is similar |
c | to the pre-processing sort used in dngets |
c | except that the sort is done in the opposite |
c | order. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SR'
if (which .eq. 'SM') wprime = 'LR'
if (which .eq. 'LR') wprime = 'SM'
if (which .eq. 'SR') wprime = 'LM'
if (which .eq. 'LI') wprime = 'SM'
if (which .eq. 'SI') wprime = 'LM'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %----------------------------------------------%
c | Now sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritzr, ritzi and bounds, and the most |
c | desired one appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call dsortc (wprime, .true., kplusp, ritzr, ritzi, bounds)
c
c %--------------------------------------------------%
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, numcnv
temp = max(eps23,dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)/temp
35 continue
c
c %----------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | esitmates. This will push all the converged ones |
c | towards the front of ritzr, ritzi, bounds |
c | (in the case when NCONV < NEV.) |
c %----------------------------------------------------%
c
wprime = 'LR'
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, numcnv
temp = max(eps23, dlapy2 (ritzr(j),
& ritzi(j)))
bounds(j) = bounds(j)*temp
40 continue
c
c %------------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritzr, ritzi and bound. |
c %------------------------------------------------%
c
call dsortc (which, .true., nconv, ritzr, ritzi, bounds)
c
c
if (msglvl .gt. 1) then
call dvout (logfil, kplusp, ritzr, ndigit,
& '_naup2: Sorted real part of the eigenvalues')
call dvout (logfil, kplusp, ritzi, ndigit,
& '_naup2: Sorted imaginary part of the eigenvalues')
call dvout (logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. numcnv) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. numcnv) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. numcnv) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pdngets (comm, ishift, which, nev, np, ritzr, ritzi,
& bounds, workl, workl(np+1))
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pdvout (comm, logfil, nev, ritzr(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- real part')
call pdvout (comm, logfil, nev, ritzi(np+1), ndigit,
& '_naup2: "wanted" Ritz values -- imag part')
call pdvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: reverse comminucation to |
c | compute the shifts. They are returned in the first |
c | 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
c
50 continue
c
c %------------------------------------%
c | Back from reverse communication; |
c | User specified shifts are returned |
c | in WORKL(1:2*NP) |
c %------------------------------------%
c
ushift = .false.
c
if ( ishift .eq. 0 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZR, RITZI to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call dcopy (np, workl, 1, ritzr, 1)
call dcopy (np, workl(np+1), 1, ritzi, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pdvout (comm, logfil, np, ritzr, ndigit,
& '_naup2: Real part of the shifts')
call pdvout (comm, logfil, np, ritzi, ndigit,
& '_naup2: Imaginary part of the shifts')
if ( ishift .eq. 1 )
& call pdvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pdnapps (comm, n, nev, np, ritzr, ritzi, 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 pdnaitr . |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd, 1)
call dgsum2d ( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2 ( comm, n, resid, 1 )
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pdmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = numcnv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tnaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pdnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psnapps.f 0000644 0001750 0001750 00000056030 12277373057 014514 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psnapps
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call psnapps
c ( COMM, N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Real array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to psnapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Real work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c slabad LAPACK routine that computes machine constants.
c slacpy LAPACK matrix copy routine.
c pslamch ScaLAPACK routine that determines machine constants.
c slanhs LAPACK routine that computes various norms of a matrix.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c slarf LAPACK routine that applies Householder reflection to
c a matrix.
c slarfg LAPACK Householder reflection construction routine.
c slartg LAPACK Givens rotation construction routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another .
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: napps.F SID: 2.2
c
c\SCCS Information:
c FILE: napps.F SID: 1.5 DATE OF SID: 03/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine slahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnapps
& ( comm, n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid,
& q, ldq, workl, workd )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Real
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slarf, slarfg, slartg,
& slaset, slabad, arscnd, pivout, psvout, psmout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch, slanhs, slapy2
external pslamch, slanhs, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------------%
c
unfl = pslamch( comm, 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call psvout (comm, logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call psvout (comm, logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call psvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call slartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = slapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call slarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call slarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call slarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call slarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call sscal( kplusp-j+1, -one, h(j+1,j), ldh )
call sscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call sscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call sgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %---------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %---------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call saxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call psvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call psmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %----------------%
c | End of psnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pssaupd.f 0000644 0001750 0001750 00000071547 12277373057 014521 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pssaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pssaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pssaupd. 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 pssaupd 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 -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
c
c NEV Integer. (INPUT)
c Number of eigenvalues of OP to be computed. 0 < NEV < N.
c
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pssaupd 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), pssaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 psseupd. 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 psseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
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
c WORKD(1:N) contains B*RESID(1:N). If the Ritz vectors are desired
c subroutine psseupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 ssteqr.
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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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 psseupd.
c
c 2. If the Ritz vectors corresponding to the converged Ritz values
c are needed, the user must call psseupd immediately following completion
c of pssaupd. 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 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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 pssaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c sstats ARPACK routine that initializes timing and other statistics
c variables.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Authors
c Kristi Maschhoff ( Parallel Code )
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saupd.F SID: 2.4
c
c\SCCS Information:
c FILE: saupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pssaup2, psvout, pivout, arscnd, sstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pslamch(comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
call pssaup2
& ( comm, 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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pssaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
call psvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
call psvout (comm, logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.1' , 19x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pssaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcneigh.f 0000644 0001750 0001750 00000020535 12277373057 014446 0000000 0000000 c\BeginDoc
c
c\Name: pcneigh
c
c Message Passing Layer: BLACS
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 pcneigh
c ( COMM, RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
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 pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c psvout Parallel 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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: neigh.F SID: 2.1
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcneigh (comm, rnorm, n, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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.0, 0.0), zero = (0.0, 0.0),
& rone = 1.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, csscal, ctrevc, ccopy,
& pcmout, pcvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2
external scnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mceigh
c
if (msglvl .gt. 2) then
call pcmout (comm, 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 pcvout (comm, 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 pcvout (comm, 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 pcvout (comm, logfil, n, ritz, ndigit,
& '_neigh: The eigenvalues of H')
call pcvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pcneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pznaup2.f 0000644 0001750 0001750 00000072416 12277373057 014435 0000000 0000000 c\BeginDoc
c
c\Name: pznaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by pznaupd.
c
c\Usage:
c call pznaup2
c ( COMM, 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 COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pznaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pznaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
c
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 (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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 PZNAUPD.
c
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
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pzgetv0 Parallel ARPACK initial vector generation routine.
c pznaitr Parallel ARPACK Arnoldi factorization routine.
c pznapps Parallel ARPACK application of implicit shifts routine.
c pzneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pzngets Parallel ARPACK reorder Ritz values and error bounds routine.
c zsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c pdvout ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK 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 pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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 FILE: naup2.F SID: 1.7 DATE OF SID: 10/25/03 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaup2
& ( comm, 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 )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external zgsum2d
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical cnorm, getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex*16
& cmpnorm
Double precision
& rnorm, eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0, eps23
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy, pzgetv0, pznaitr, pzneigh, pzngets, pznapps,
& zsortc, zswap, pzmout, pzvout, pivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
Complex*16
& zdotc
Double precision
& pdznorm2, pdlamch, dlapy2
external zdotc, pdznorm2, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, min, max, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pzgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pznaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pznapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pznaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pzneigh ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
c | Ritz estimates obtained from pzneigh. |
c %--------------------------------------------------%
c
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 |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call pzngets ( comm, ishift, which, nev, np, ritz,
& bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
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)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call pzvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call pzvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call pzvout(comm, logfil, kplusp,
& workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call pzvout(comm, logfil, kplusp,
& workl(kplusp**2+kplusp+1), ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to pzneupd if needed |
c %------------------------------------------%
c
h(3,1) = dcmplx(rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call zsortc(wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, dlapy2( dble(ritz(j)),
& dimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call zsortc(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, dlapy2( dble(ritz(j)),
& dimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call zsortc(which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call pzvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call pzvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pzngets (comm, ishift, which, nev, np, ritz,
& bounds)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pzvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call pzvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call zcopy (np, workl, 1, ritz, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pzvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call pzvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pznapps(comm, 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 pznaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cmpnorm = zdotc (n, resid, 1, workd, 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cmpnorm, 1, -1, -1 )
rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pzmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pznaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/Makefile.in 0000644 0001750 0001750 00000041654 12277667632 014741 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/SRC/BLACS
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libparpacksrc_la_LIBADD =
am_libparpacksrc_la_OBJECTS = pcgetv0.lo pdlamch.lo pdsaitr.lo \
pslamch.lo pssaitr.lo pznapps.lo pclarnv.lo pdlarnv.lo \
pdsapps.lo pslarnv.lo pssapps.lo pznaup2.lo pcnaitr.lo \
pdnaitr.lo pdsaup2.lo psnaitr.lo pssaup2.lo pznaupd.lo \
pcnapps.lo pdnapps.lo pdsaupd.lo psnapps.lo pssaupd.lo \
pzneigh.lo pcnaup2.lo pdnaup2.lo pdseigt.lo psnaup2.lo \
psseigt.lo pzneupd.lo pcnaupd.lo pdnaupd.lo pdseupd.lo \
psnaupd.lo psseupd.lo pzngets.lo pcneigh.lo pdneigh.lo \
pdsgets.lo psneigh.lo pssgets.lo pcneupd.lo pdneupd.lo \
pdznorm2.lo psneupd.lo pzgetv0.lo pcngets.lo pdngets.lo \
pscnorm2.lo psngets.lo pzlarnv.lo pdgetv0.lo pdnorm2.lo \
psgetv0.lo psnorm2.lo pznaitr.lo
libparpacksrc_la_OBJECTS = $(am_libparpacksrc_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libparpacksrc_la_SOURCES)
DIST_SOURCES = $(libparpacksrc_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libparpacksrc.la
libparpacksrc_la_SOURCES = \
pcgetv0.f pdlamch.f pdsaitr.f pslamch.f pssaitr.f pznapps.f \
pclarnv.f pdlarnv.f pdsapps.f pslarnv.f pssapps.f pznaup2.f \
pcnaitr.f pdnaitr.f pdsaup2.f psnaitr.f pssaup2.f pznaupd.f \
pcnapps.f pdnapps.f pdsaupd.f psnapps.f pssaupd.f pzneigh.f \
pcnaup2.f pdnaup2.f pdseigt.f psnaup2.f psseigt.f pzneupd.f \
pcnaupd.f pdnaupd.f pdseupd.f psnaupd.f psseupd.f pzngets.f \
pcneigh.f pdneigh.f pdsgets.f psneigh.f pssgets.f \
pcneupd.f pdneupd.f pdznorm2.f psneupd.f pzgetv0.f \
pcngets.f pdngets.f pscnorm2.f psngets.f pzlarnv.f \
pdgetv0.f pdnorm2.f psgetv0.f psnorm2.f pznaitr.f
EXTRA_DIST = debug.h stat.h
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/SRC/BLACS/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/SRC/BLACS/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libparpacksrc.la: $(libparpacksrc_la_OBJECTS) $(libparpacksrc_la_DEPENDENCIES) $(EXTRA_libparpacksrc_la_DEPENDENCIES)
$(AM_V_F77LD)$(F77LINK) $(libparpacksrc_la_OBJECTS) $(libparpacksrc_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdsapps.f 0000644 0001750 0001750 00000044650 12277373057 014507 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pdsapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Double precision array of length NP. (INPUT)
c The shifts to be applied.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlartg LAPACK Givens rotation construction routine.
c dlacpy LAPACK matrix copy routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another.
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sapps.F SID: 2.4
c
c\SCCS Information:
c FILE: sapps.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Double precision
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, pdvout,
& pivout, arscnd, dgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = pdlamch(comm, 'Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call dlartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call dscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pdvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call daxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call pdvout (comm, logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call pdvout (comm, logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call pdvout (comm, logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pdsapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pssgets.f 0000644 0001750 0001750 00000017070 12277373057 014521 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssgets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pssgets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Real array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Real array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Real array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c ssortr ARPACK utility sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
c sswap Level 1 BLAS that swaps the contents of two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sgets.F SID: 2.3
c
c\SCCS Information:
c FILE: sgets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssgets
& ( comm, ishift, which, kev, np, ritz, bounds, shifts )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external sswap, scopy, ssortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call ssortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call sswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call sswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call ssortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pssapps. |
c %-------------------------------------------------------%
c
call ssortr ('SM', .true., np, bounds, ritz)
call scopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call psvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call psvout (comm, logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %----------------%
c | End of pssgets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdnaupd.f 0000644 0001750 0001750 00000073440 12277373057 014467 0000000 0000000 c\BeginDoc
c
c\Name: pdnaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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 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.
c
c pdnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pdnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdnaupd . 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 pdnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Double precision array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pdnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), pdnaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by dneupd . See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 pdneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
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 an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine dneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine dneupd .
c
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 pdnaupd . This is new starting with release 2 of ARPACK.
c
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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Double precision resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Double precision resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c pdnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.9 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdnaup2 , pdvout , pivout, arscnd, dstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pdlamch (comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine pdneigh called |
c | by pdnaup2 . Subroutine dneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call pdnaup2
& ( comm, ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pdnaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call pdvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call pdvout (comm, logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call pdvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pdnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pzgetv0.f 0000644 0001750 0001750 00000034747 12277373057 014442 0000000 0000000 c\BeginDoc
c
c\Name: pzgetv0
c
c Message Passing Layer: BLACS
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call pzgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pzgetv0 .
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that pzgetv0 is called.
c It should be set to 1 on the initial call to pzgetv0 .
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Complex*16 N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Double precision scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Complex*16 work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Complex*16 work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c pzvout Parallel ARPACK utility routine that prints vectors.
c pzlarnv Parallel wrapper for LAPACK routine zlarnv (generates a random vector).
c zgemv Level 2 BLAS routine for matrix vector multiplication.
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 pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: getv0.F SID: 2.1
c
c\SCCS Information:
c FILE: getv0.F SID: 1.7 DATE OF SID: 04/12/01
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external zgsum2d , blacs_gridinfo
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) ,
& rzero = 0.0 )
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj, myid, igen
Double precision
& rnorm0
Complex*16
& cnorm, cnorm2
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy , zgemv , pzlarnv , pzvout , arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdznorm2 , dlapy2
Complex*16
& zdotc
external zdotc , pdznorm2 , dlapy2
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
c
c %-----------------------------------%
c | Generate a seed on each processor |
c | using process id (myid). |
c | Note: the seed must be between 1 |
c | and 4095. iseed(4) must be odd. |
c %-----------------------------------%
c
call BLACS_GRIDINFO(comm, nprow, npcol, myprow, mypcol)
c
c %-------------------------------------------%
c | Convert a 2-D process id (myprow, mypcol) |
c | to a 1-D process id (myid). |
c %-------------------------------------------%
c
myid = npcol*myprow + mypcol + 1
igen = 1000 + 2*myid - 1
if (igen .gt. 4095) then
write(0,*) 'Error in p_getv0: seed exceeds 4095!'
end if
c
iseed(1) = igen/1000
igen = mod(igen,1000)
iseed(2) = igen/100
igen = mod(igen,100)
iseed(3) = igen/10
iseed(4) = mod(igen,10)
c
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pzlarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call zcopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %----------------------------------------%
c | Back from computing B*(initial-vector) |
c %----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
call zgsum2d ( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm0 = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = pdznorm2 ( comm, n, resid, 1)
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett`s book, page 107 and in Gragg and Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call zgemv ('C', n, j-1, one, v, ldv, workd, 1,
& zero, workl, 1)
call zgsum2d ( comm, 'All', ' ', j-1, 1, workl, j, -1, -1 )
call zgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
call zgsum2d ( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
rnorm = pdznorm2 (comm, n, resid, 1)
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call pdvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 5 ) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = rzero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
cnorm2 = dcmplx (rnorm,rzero)
call pzvout (comm, logfil, 1, cnorm2, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call pzvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pzgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdsgets.f 0000644 0001750 0001750 00000017164 12277373057 014506 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsgets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the symmetric tridiagonal matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: This is called even in the case of user specified shifts in
c order to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pdsgets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS, SHIFTS )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> KEV eigenvalues of largest magnitude are retained.
c 'SM' -> KEV eigenvalues of smallest magnitude are retained.
c 'LA' -> KEV eigenvalues of largest value are retained.
c 'SA' -> KEV eigenvalues of smallest value are retained.
c 'BE' -> KEV eigenvalues, half from each end of the spectrum.
c If KEV is odd, compute one more from the high end.
c
c KEV Integer. (INPUT)
c KEV+NP is the size of the matrix H.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be computed.
c
c RITZ Double precision array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted eigenvalues
c are in the first NP locations and the wanted part is in
c the last KEV locations. When exact shifts are selected, the
c unwanted part corresponds to the shifts to be applied.
c
c BOUNDS Double precision array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c SHIFTS Double precision array of length NP. (INPUT/OUTPUT)
c On INPUT: contains the user specified shifts if ISHIFT = 0.
c On OUTPUT: contains the shifts sorted into decreasing order
c of magnitude with respect to the Ritz estimates contained in
c BOUNDS. If ISHIFT = 0, SHIFTS is not modified on exit.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c dsortr ARPACK utility sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c dcopy Level 1 BLAS that copies one vector to another.
c dswap Level 1 BLAS that swaps the contents of two vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sgets.F SID: 2.3
c
c\SCCS Information:
c FILE: sgets.F SID: 1.2 DATE OF SID: 2/22/96
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsgets
& ( comm, ishift, which, kev, np, ritz, bounds, shifts )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& bounds(kev+np), ritz(kev+np), shifts(np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer kevd2, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external dswap, dcopy, dsortr, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic max, min
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msgets
c
if (which .eq. 'BE') then
c
c %-----------------------------------------------------%
c | Both ends of the spectrum are requested. |
c | Sort the eigenvalues into algebraically increasing |
c | order first then swap high end of the spectrum next |
c | to low end in appropriate locations. |
c | NOTE: when np < floor(kev/2) be careful not to swap |
c | overlapping locations. |
c %-----------------------------------------------------%
c
call dsortr ('LA', .true., kev+np, ritz, bounds)
kevd2 = kev / 2
if ( kev .gt. 1 ) then
call dswap ( min(kevd2,np), ritz, 1,
& ritz( max(kevd2,np)+1 ), 1)
call dswap ( min(kevd2,np), bounds, 1,
& bounds( max(kevd2,np)+1 ), 1)
end if
c
else
c
c %----------------------------------------------------%
c | LM, SM, LA, SA case. |
c | Sort the eigenvalues of H into the desired order |
c | and apply the resulting order to BOUNDS. |
c | The eigenvalues are sorted so that the wanted part |
c | are always in the last KEV locations. |
c %----------------------------------------------------%
c
call dsortr (which, .true., kev+np, ritz, bounds)
end if
c
if (ishift .eq. 1 .and. np .gt. 0) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first. |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pdsapps. |
c %-------------------------------------------------------%
c
call dsortr ('SM', .true., np, bounds, ritz)
call dcopy (np, ritz, 1, shifts, 1)
end if
c
call arscnd (t1)
tsgets = tsgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_sgets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_sgets: NP is')
call pdvout (comm, logfil, kev+np, ritz, ndigit,
& '_sgets: Eigenvalues of current H matrix')
call pdvout (comm, logfil, kev+np, bounds, ndigit,
& '_sgets: Associated Ritz estimates')
end if
c
return
c
c %----------------%
c | End of pdsgets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdlamch.f 0000644 0001750 0001750 00000005076 12277373057 014444 0000000 0000000 DOUBLE PRECISION FUNCTION PDLAMCH( ICTXT, CMACH )
*
* -- ScaLAPACK auxilliary routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
CHARACTER CMACH
INTEGER ICTXT
* ..
*
* Purpose
* =======
*
* PDLAMCH determines double precision machine parameters.
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle in which the computation takes
* place.
*
* CMACH (global input) CHARACTER*1
* Specifies the value to be returned by PDLAMCH:
* = 'E' or 'e', PDLAMCH := eps
* = 'S' or 's , PDLAMCH := sfmin
* = 'B' or 'b', PDLAMCH := base
* = 'P' or 'p', PDLAMCH := eps*base
* = 'N' or 'n', PDLAMCH := t
* = 'R' or 'r', PDLAMCH := rnd
* = 'M' or 'm', PDLAMCH := emin
* = 'U' or 'u', PDLAMCH := rmin
* = 'L' or 'l', PDLAMCH := emax
* = 'O' or 'o', PDLAMCH := rmax
*
* where
*
* eps = relative machine precision
* sfmin = safe minimum, such that 1/sfmin does not overflow
* base = base of the machine
* prec = eps*base
* t = number of (base) digits in the mantissa
* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
* emin = minimum exponent before (gradual) underflow
* rmin = underflow threshold - base**(emin-1)
* emax = largest exponent before overflow
* rmax = overflow threshold - (base**emax)*(1-eps)
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER IDUMM
DOUBLE PRECISION TEMP
* ..
* .. External Subroutines ..
EXTERNAL DGAMN2D, DGAMX2D
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH
EXTERNAL DLAMCH, LSAME
* ..
* .. Executable Statements ..
*
TEMP = DLAMCH( CMACH )
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL DGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
$ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL DGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
$ IDUMM, 1, -1, IDUMM )
END IF
*
PDLAMCH = TEMP
*
* End of PDLAMCH
*
END
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcnapps.f 0000644 0001750 0001750 00000043106 12277373057 014474 0000000 0000000 c\BeginDoc
c
c\Name: pcnapps
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pcnapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c clacpy LAPACK matrix copy routine.
c clanhs LAPACK routine that computes various norms of a matrix.
c clartg LAPACK Givens rotation construction routine.
c claset LAPACK matrix initialization routine.
c slabad LAPACK routine for defining the underflow and overflow
c limits.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c cgemv Level 2 BLAS routine for matrix vector multiplication.
c caxpy Level 1 BLAS that computes a vector triad.
c ccopy Level 1 BLAS that copies one vector to another.
c cscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: napps.F SID: 2.1
c
c\SCCS Information:
c FILE: napps.F SID: 1.4 DATE OF SID: 10/25/03
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine clahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex
& cdum, f, g, h11, h21, r, s, sigma, t
Real
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external caxpy, ccopy, cgemv, cscal, clacpy, clartg,
& pcvout, claset, slabad, pcmout, arscnd, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& clanhs, pslamch, slapy2
external clanhs, pslamch, slapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, aimag, conjg, cmplx, max, min, real
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Real
& cabs1
cabs1( cdum ) = abs( real( cdum ) ) + abs( aimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine clahqr |
c %-----------------------------------------------%
c
unfl = pslamch( 'safe minimum' )
ovfl = real(one / unfl)
call slabad( unfl, ovfl )
ulp = slamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call claset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pcvout (comm, logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr |
c %----------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = clanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(real(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pcvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call clartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( real( h(j+1,j) ) .lt. rzero .or.
& aimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / slapy2(real(h(j+1,j)),aimag(h(j+1,j)))
call cscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call cscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call cscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = cmplx( real( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine clahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = clanhs( '1', kev, h, ldh, workl )
if( real( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call cgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call cgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call ccopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call clacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( real( h(kev+1,kev) ) .gt. rzero )
& call ccopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call cscal (n, q(kplusp,kev), resid, 1)
if ( real( h(kev+1,kev) ) .gt. rzero )
& call caxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pcvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pcvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pcmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pcnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcnaup2.f 0000644 0001750 0001750 00000072241 12277373057 014402 0000000 0000000 c\BeginDoc
c
c\Name: pcnaup2
c
c Message Passing Layer: BLACS
c
c\Description:
c Intermediate level interface called by pcnaupd.
c
c\Usage:
c call pcnaup2
c ( COMM, 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 COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID: same as defined in pcnaupd.
c MODE, ISHIFT, MXITER: see the definition of IPARAM in pcnaupd.
c
c NP Integer. (INPUT/OUTPUT)
c Contains the number of implicit shifts to apply during
c each Arnoldi iteration.
c If ISHIFT=1, NP is adjusted dynamically at each iteration
c to accelerate convergence and prevent stagnation.
c This is also roughly equal to the number of matrix-vector
c products (involving the operator OP) per Arnoldi iteration.
c The logic for adjusting is contained within the current
c subroutine.
c If ISHIFT=0, NP is the number of shifts the user needs
c to provide via reverse comunication. 0 < NP < NCV-NEV.
c NP may be less than NCV-NEV since a leading block of the current
c upper Hessenberg matrix has split off and contains "unwanted"
c Ritz values.
c Upon termination of the IRA iteration, NP contains the number
c of "converged" wanted Ritz values.
c
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 The Arnoldi basis vectors are returned in the first NEV
c columns of V.
c
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 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(1:NEV) contains the computed Ritz values of OP.
c
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 Private (replicated) work array used to accumulate the
c rotation in the shift application step.
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 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
c application and convergence checking.
c
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORKD for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 PCNAUPD.
c
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
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal return.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found.
c NP returns the number of converged Ritz values.
c = 2: No shifts could be applied.
c = -8: Error return from LAPACK eigenvalue calculation;
c This should never happen.
c = -9: Starting vector is zero.
c = -9999: Could not build an Arnoldi factorization.
c Size that was built in returned in NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pcgetv0 Parallel ARPACK initial vector generation routine.
c pcnaitr Parallel ARPACK Arnoldi factorization routine.
c pcnapps Parallel ARPACK application of implicit shifts routine.
c pcneigh Parallel ARPACK compute Ritz values and error bounds routine.
c pcngets Parallel ARPACK reorder Ritz values and error bounds routine.
c csortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c psvout ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c ccopy Level 1 BLAS that copies one vector to another .
c cdotc Level 1 BLAS that computes the scalar product of two vectors.
c cswap Level 1 BLAS that swaps two vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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 FILE: naup2.F SID: 1.7 DATE OF SID: 10/25/03 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcnaup2
& ( comm, 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 )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external cgsum2d
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
character bmat*1, which*2
integer ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
& n, nev, np
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(13)
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
& rwork(nev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
Real
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical cnorm, getv0, initv , update, ushift
integer ierr , iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0 , nptemp, i ,
& j
Complex
& cmpnorm
Real
& rnorm, eps23, rtemp
character wprime*2
c
save cnorm, getv0, initv , update, ushift,
& rnorm, iter , kplusp, msglvl, nconv,
& nevbef, nev0 , np0, eps23
c
c %-----------------------%
c | Local array arguments |
c %-----------------------%
c
integer kp(3)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy, pcgetv0, pcnaitr, pcneigh, pcngets, pcnapps,
& csortc, cswap, pcmout, pcvout, pivout, arscnd
c
c %--------------------%
c | External functions |
c %--------------------%
c
Complex
& cdotc
Real
& pscnorm2, pslamch, slapy2
external cdotc, pscnorm2, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic aimag, real, min, max, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
call arscnd (t0)
c
msglvl = mcaup2
c
nev0 = nev
np0 = np
c
c %-------------------------------------%
c | kplusp is the bound on the largest |
c | Lanczos factorization built. |
c | nconv is the current number of |
c | "converged" eigenvalues. |
c | iter is the counter on the current |
c | iteration step. |
c %-------------------------------------%
c
kplusp = nev + np
nconv = 0
iter = 0
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %---------------------------------------%
c | Set flags for computing the first NEV |
c | steps of the Arnoldi factorization. |
c %---------------------------------------%
c
getv0 = .true.
update = .false.
ushift = .false.
cnorm = .false.
c
if (info .ne. 0) then
c
c %--------------------------------------------%
c | User provides the initial residual vector. |
c %--------------------------------------------%
c
initv = .true.
info = 0
else
initv = .false.
end if
end if
c
c %---------------------------------------------%
c | Get a possibly random starting vector and |
c | force it into the range of the operator OP. |
c %---------------------------------------------%
c
10 continue
c
if (getv0) then
call pcgetv0 (comm, ido, bmat, 1, initv, n, 1, v, ldv,
& resid, rnorm, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (rnorm .eq. rzero) then
c
c %-----------------------------------------%
c | The initial vector is zero. Error exit. |
c %-----------------------------------------%
c
info = -9
go to 1100
end if
getv0 = .false.
ido = 0
end if
c
c %-----------------------------------%
c | Back from reverse communication : |
c | continue with update step |
c %-----------------------------------%
c
if (update) go to 20
c
c %-------------------------------------------%
c | Back from computing user specified shifts |
c %-------------------------------------------%
c
if (ushift) go to 50
c
c %-------------------------------------%
c | Back from computing residual norm |
c | at the end of the current iteration |
c %-------------------------------------%
c
if (cnorm) go to 100
c
c %----------------------------------------------------------%
c | Compute the first NEV steps of the Arnoldi factorization |
c %----------------------------------------------------------%
c
call pcnaitr (comm, ido, bmat, n, 0, nev, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
c
c %--------------------------------------------------------------%
c | |
c | M A I N ARNOLDI I T E R A T I O N L O O P |
c | Each iteration implicitly restarts the Arnoldi |
c | factorization in place. |
c | |
c %--------------------------------------------------------------%
c
1000 continue
c
iter = iter + 1
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, iter, ndigit,
& '_naup2: **** Start of major iteration number ****')
end if
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 pcnapps. |
c %-----------------------------------------------------------%
c
np = kplusp - nev
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, nev, ndigit,
& '_naup2: The length of the current Arnoldi factorization')
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: Extend the Arnoldi factorization by')
end if
c
c %-----------------------------------------------------------%
c | Compute NP additional steps of the Arnoldi factorization. |
c %-----------------------------------------------------------%
c
ido = 0
20 continue
update = .true.
c
call pcnaitr (comm, ido, bmat, n, nev, np, mode,
& resid, rnorm, v, ldv,
& h, ldh, ipntr, workd, workl, info)
c
if (ido .ne. 99) go to 9000
c
if (info .gt. 0) then
np = info
mxiter = iter
info = -9999
go to 1200
end if
update = .false.
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: Corresponding B-norm of the residual')
end if
c
c %--------------------------------------------------------%
c | Compute the eigenvalues and corresponding error bounds |
c | of the current upper Hessenberg matrix. |
c %--------------------------------------------------------%
c
call pcneigh ( comm, rnorm, kplusp, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
if (ierr .ne. 0) then
info = -8
go to 1200
end if
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | error bounds are in the last NEV loc. of RITZ, |
c | and BOUNDS respectively. |
c %---------------------------------------------------%
c
nev = nev0
np = np0
c
c %--------------------------------------------------%
c | Make a copy of Ritz values and the corresponding |
c | Ritz estimates obtained from pcneigh. |
c %--------------------------------------------------%
c
call ccopy(kplusp,ritz,1,workl(kplusp**2+1),1)
call ccopy(kplusp,bounds,1,workl(kplusp**2+kplusp+1),1)
c
c %---------------------------------------------------%
c | Select the wanted Ritz values and their bounds |
c | to be used in the convergence test. |
c | The wanted part of the spectrum and corresponding |
c | bounds are in the last NEV loc. of RITZ |
c | BOUNDS respectively. |
c %---------------------------------------------------%
c
call pcngets ( comm, ishift, which, nev, np, ritz,
& bounds)
c
c %------------------------------------------------------------%
c | Convergence test: currently we use the following criteria. |
c | The relative accuracy of a Ritz value is considered |
c | acceptable if: |
c | |
c | error_bounds(i) .le. tol*max(eps23, magnitude_of_ritz(i)). |
c | |
c %------------------------------------------------------------%
c
nconv = 0
c
do 25 i = 1, nev
rtemp = max( eps23, slapy2( real(ritz(np+i)),
& aimag(ritz(np+i)) ) )
if ( slapy2(real(bounds(np+i)),aimag(bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
25 continue
c
if (msglvl .gt. 2) then
kp(1) = nev
kp(2) = np
kp(3) = nconv
call pivout (comm, logfil, 3, kp, ndigit,
& '_naup2: NEV, NP, NCONV are')
call pcvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: The eigenvalues of H')
call pcvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Ritz estimates of the current NCV Ritz values')
end if
c
c %---------------------------------------------------------%
c | Count the number of unwanted Ritz values that have zero |
c | Ritz estimates. If any Ritz estimates are equal to zero |
c | then a leading block of H of order equal to at least |
c | the number of Ritz values with zero Ritz estimates has |
c | split off. None of these Ritz values may be removed by |
c | shifting. Decrease NP the number of shifts to apply. If |
c | no shifts may be applied, then prepare to exit |
c %---------------------------------------------------------%
c
nptemp = np
do 30 j=1, nptemp
if (bounds(j) .eq. zero) then
np = np - 1
nev = nev + 1
end if
30 continue
c
if ( (nconv .ge. nev0) .or.
& (iter .gt. mxiter) .or.
& (np .eq. 0) ) then
c
if (msglvl .gt. 4) then
call pcvout(comm, logfil, kplusp,
& workl(kplusp**2+1), ndigit,
& '_naup2: Eigenvalues computed by _neigh:')
call pcvout(comm, logfil, kplusp,
& workl(kplusp**2+kplusp+1), ndigit,
& '_naup2: Ritz eistmates computed by _neigh:')
end if
c
c %------------------------------------------------%
c | Prepare to exit. Put the converged Ritz values |
c | and corresponding bounds in RITZ(1:NCONV) and |
c | BOUNDS(1:NCONV) respectively. Then sort. Be |
c | careful when NCONV > NP |
c %------------------------------------------------%
c
c %------------------------------------------%
c | Use h( 3,1 ) as storage to communicate |
c | rnorm to pcneupd if needed |
c %------------------------------------------%
c
h(3,1) = cmplx(rnorm,rzero)
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
c | values appear within the first NEV locations |
c | of ritz and bounds, and the most desired one |
c | appears at the front. |
c %----------------------------------------------%
c
if (which .eq. 'LM') wprime = 'SM'
if (which .eq. 'SM') wprime = 'LM'
if (which .eq. 'LR') wprime = 'SR'
if (which .eq. 'SR') wprime = 'LR'
if (which .eq. 'LI') wprime = 'SI'
if (which .eq. 'SI') wprime = 'LI'
c
call csortc(wprime, .true., kplusp, ritz, bounds)
c
c %--------------------------------------------------%
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
rtemp = max( eps23, slapy2( real(ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
c %---------------------------------------------------%
c | Sort the Ritz values according to the scaled Ritz |
c | estimates. This will push all the converged ones |
c | towards the front of ritz, bounds (in the case |
c | when NCONV < NEV.) |
c %---------------------------------------------------%
c
wprime = 'LM'
call csortc(wprime, .true., nev0, bounds, ritz)
c
c %----------------------------------------------%
c | Scale the Ritz estimate back to its original |
c | value. |
c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, slapy2( real(ritz(j)),
& aimag(ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
c %-----------------------------------------------%
c | Sort the converged Ritz values again so that |
c | the "threshold" value appears at the front of |
c | ritz and bound. |
c %-----------------------------------------------%
c
call csortc(which, .true., nconv, ritz, bounds)
c
if (msglvl .gt. 1) then
call pcvout (comm, logfil, kplusp, ritz, ndigit,
& '_naup2: Sorted eigenvalues')
call pcvout (comm, logfil, kplusp, bounds, ndigit,
& '_naup2: Sorted ritz estimates.')
end if
c
c %------------------------------------%
c | Max iterations have been exceeded. |
c %------------------------------------%
c
if (iter .gt. mxiter .and. nconv .lt. nev0) info = 1
c
c %---------------------%
c | No shifts to apply. |
c %---------------------%
c
if (np .eq. 0 .and. nconv .lt. nev0) info = 2
c
np = nconv
go to 1100
c
else if ( (nconv .lt. nev0) .and. (ishift .eq. 1) ) then
c
c %-------------------------------------------------%
c | Do not have all the requested eigenvalues yet. |
c | To prevent possible stagnation, adjust the size |
c | of NEV. |
c %-------------------------------------------------%
c
nevbef = nev
nev = nev + min(nconv, np/2)
if (nev .eq. 1 .and. kplusp .ge. 6) then
nev = kplusp / 2
else if (nev .eq. 1 .and. kplusp .gt. 3) then
nev = 2
end if
np = kplusp - nev
c
c %---------------------------------------%
c | If the size of NEV was just increased |
c | resort the eigenvalues. |
c %---------------------------------------%
c
if (nevbef .lt. nev)
& call pcngets (comm, ishift, which, nev, np, ritz,
& bounds)
c
end if
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, nconv, ndigit,
& '_naup2: no. of "converged" Ritz values at this iter.')
if (msglvl .gt. 1) then
kp(1) = nev
kp(2) = np
call pivout (comm, logfil, 2, kp, ndigit,
& '_naup2: NEV and NP are')
call pcvout (comm, logfil, nev, ritz(np+1), ndigit,
& '_naup2: "wanted" Ritz values ')
call pcvout (comm, logfil, nev, bounds(np+1), ndigit,
& '_naup2: Ritz estimates of the "wanted" values ')
end if
end if
c
if (ishift .eq. 0) then
c
c %-------------------------------------------------------%
c | User specified shifts: pop back out to get the shifts |
c | and return them in the first 2*NP locations of WORKL. |
c %-------------------------------------------------------%
c
ushift = .true.
ido = 3
go to 9000
end if
50 continue
ushift = .false.
c
if ( ishift .ne. 1 ) then
c
c %----------------------------------%
c | Move the NP shifts from WORKL to |
c | RITZ, to free up WORKL |
c | for non-exact shift case. |
c %----------------------------------%
c
call ccopy (np, workl, 1, ritz, 1)
end if
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, np, ndigit,
& '_naup2: The number of shifts to apply ')
call pcvout (comm, logfil, np, ritz, ndigit,
& '_naup2: values of the shifts')
if ( ishift .eq. 1 )
& call pcvout (comm, logfil, np, bounds, ndigit,
& '_naup2: Ritz estimates of the shifts')
end if
c
c %---------------------------------------------------------%
c | Apply the NP implicit shifts by QR bulge chasing. |
c | Each shift is applied to the whole upper Hessenberg |
c | matrix H. |
c | The first 2*N locations of WORKD are used as workspace. |
c %---------------------------------------------------------%
c
call pcnapps(comm, 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 pcnaitr. |
c %---------------------------------------------%
c
cnorm = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call ccopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*RESID |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call ccopy (n, resid, 1, workd, 1)
end if
c
100 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(1:N) := B*RESID |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
if (bmat .eq. 'G') then
cmpnorm = cdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cmpnorm, 1, -1, -1 )
rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = pscnorm2(comm, n, resid, 1)
end if
cnorm = .false.
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naup2: B-norm of residual for compressed factorization')
call pcmout (comm, logfil, nev, nev, h, ldh, ndigit,
& '_naup2: Compressed upper Hessenberg matrix H')
end if
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
1100 continue
c
mxiter = iter
nev = nconv
c
1200 continue
ido = 99
c
c %------------%
c | Error Exit |
c %------------%
c
call arscnd (t1)
tcaup2 = t1 - t0
c
9000 continue
c
c %----------------%
c | End of pcnaup2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psgetv0.f 0000644 0001750 0001750 00000033101 12277373057 014412 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psgetv0
c
c Message Passing Layer: BLACS
c
c\Description:
c Generate a random initial residual vector for the Arnoldi process.
c Force the residual vector to be in the range of the operator OP.
c
c\Usage:
c call psgetv0
c ( COMM, IDO, BMAT, ITRY, INITV, N, J, V, LDV, RESID, RNORM,
c IPNTR, WORKD, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to psgetv0.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B in the (generalized)
c eigenvalue problem A*x = lambda*B*x.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c ITRY Integer. (INPUT)
c ITRY counts the number of times that psgetv0 is called.
c It should be set to 1 on the initial call to psgetv0.
c
c INITV Logical variable. (INPUT)
c .TRUE. => the initial residual vector is given in RESID.
c .FALSE. => generate a random initial residual vector.
c
c N Integer. (INPUT)
c Dimension of the problem.
c
c J Integer. (INPUT)
c Index of the residual vector to be generated, with respect to
c the Arnoldi process. J > 1 in case of a "restart".
c
c V Real N by J array. (INPUT)
c The first J-1 columns of V contain the current Arnoldi basis
c if this is a "restart".
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c Initial residual vector to be generated. If RESID is
c provided, force RESID into the range of the operator OP.
c
c RNORM Real scalar. (OUTPUT)
c B-norm of the generated residual.
c
c IPNTR Integer array of length 3. (OUTPUT)
c
c WORKD Real work array of length 2*N. (REVERSE COMMUNICATION).
c On exit, WORK(1:N) = B*RESID to be used in SSAITR.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c IERR Integer. (OUTPUT)
c = 0: Normal exit.
c = -1: Cannot generate a nontrivial restarted residual vector
c in the range of the operator OP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine for vector output.
c pslarnv Parallel wrapper for LAPACK routine slarnv (generates a random vector).
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c scopy Level 1 BLAS that copies one vector to another.
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: getv0.F SID: 2.3
c
c\SCCS Information:
c FILE: getv0.F SID: 1.4 DATE OF SID: 3/19/97
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psgetv0
& ( comm, ido, bmat, itry, initv, n, j, v, ldv, resid, rnorm,
& ipntr, workd, workl, ierr )
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d
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
character bmat*1
logical initv
integer ido, ierr, itry, j, ldv, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& resid(n), v(ldv,j), workd(2*n), workl(2*j)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical first, inits, orth
integer idist, iseed(4), iter, msglvl, jj
Real
& rnorm0
save first, iseed, inits, iter, msglvl, orth, rnorm0
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pslarnv, psvout, scopy, sgemv, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2
external sdot, psnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data Statements |
c %-----------------%
c
data inits /.true./
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-----------------------------------%
c | Initialize the seed of the LAPACK |
c | random number generator |
c %-----------------------------------%
c
if (inits) then
iseed(1) = 1
iseed(2) = 3
iseed(3) = 5
iseed(4) = 7
inits = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mgetv0
c
ierr = 0
iter = 0
first = .FALSE.
orth = .FALSE.
c
c %-----------------------------------------------------%
c | Possibly generate a random starting vector in RESID |
c | Use a LAPACK random number generator used by the |
c | matrix generation routines. |
c | idist = 1: uniform (0,1) distribution; |
c | idist = 2: uniform (-1,1) distribution; |
c | idist = 3: normal (0,1) distribution; |
c %-----------------------------------------------------%
c
if (.not.initv) then
idist = 2
call pslarnv (comm, idist, iseed, n, resid)
end if
c
c %----------------------------------------------------------%
c | Force the starting vector into the range of OP to handle |
c | the generalized problem when B is possibly (singular). |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nopx = nopx + 1
ipntr(1) = 1
ipntr(2) = n + 1
call scopy (n, resid, 1, workd, 1)
ido = -1
go to 9000
end if
end if
c
c %-----------------------------------------%
c | Back from computing OP*(initial-vector) |
c %-----------------------------------------%
c
if (first) go to 20
c
c %-----------------------------------------------%
c | Back from computing B*(orthogonalized-vector) |
c %-----------------------------------------------%
c
if (orth) go to 40
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
c %------------------------------------------------------%
c | Starting vector is now in the range of OP; r = OP*r; |
c | Compute B-norm of starting vector. |
c %------------------------------------------------------%
c
call arscnd (t2)
first = .TRUE.
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, workd(n+1), 1, resid, 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
20 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
first = .FALSE.
if (bmat .eq. 'G') then
rnorm0 = sdot (n, resid, 1, workd, 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm0, 1, -1, -1 )
rnorm0 = sqrt(abs(rnorm0))
else if (bmat .eq. 'I') then
rnorm0 = psnorm2( comm, n, resid, 1 )
end if
rnorm = rnorm0
c
c %---------------------------------------------%
c | Exit if this is the very first Arnoldi step |
c %---------------------------------------------%
c
if (j .eq. 1) go to 50
c
c %----------------------------------------------------------------
c | Otherwise need to B-orthogonalize the starting vector against |
c | the current Arnoldi basis using Gram-Schmidt with iter. ref. |
c | This is the case where an invariant subspace is encountered |
c | in the middle of the Arnoldi factorization. |
c | |
c | s = V^{T}*B*r; r = r - V*s; |
c | |
c | Stopping criteria used for iter. ref. is discussed in |
c | Parlett's book, page 107 and in Gragg & Reichel TOMS paper. |
c %---------------------------------------------------------------%
c
orth = .TRUE.
30 continue
c
call sgemv ('T', n, j-1, one, v, ldv, workd, 1,
& zero, workl, 1)
call sgsum2d( comm, 'All', ' ', j-1, 1, workl, j, -1, -1 )
call sgemv ('N', n, j-1, -one, v, ldv, workl, 1,
& one, resid, 1)
c
c %----------------------------------------------------------%
c | Compute the B-norm of the orthogonalized starting vector |
c %----------------------------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(n+1), 1)
ipntr(1) = n + 1
ipntr(2) = 1
ido = 2
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd, 1)
end if
c
40 continue
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
endif
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd, 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %--------------------------------------%
c | Check for further orthogonalization. |
c %--------------------------------------%
c
if (msglvl .gt. 2) then
call psvout (comm, logfil, 1, rnorm0, ndigit,
& '_getv0: re-orthonalization ; rnorm0 is')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: re-orthonalization ; rnorm is')
end if
c
if (rnorm .gt. 0.717*rnorm0) go to 50
c
iter = iter + 1
if (iter .le. 1) then
c
c %-----------------------------------%
c | Perform iterative refinement step |
c %-----------------------------------%
c
rnorm0 = rnorm
go to 30
else
c
c %------------------------------------%
c | Iterative refinement step "failed" |
c %------------------------------------%
c
do 45 jj = 1, n
resid(jj) = zero
45 continue
rnorm = zero
ierr = -1
end if
c
50 continue
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_getv0: B-norm of initial / restarted starting vector')
end if
if (msglvl .gt. 2) then
call psvout (comm, logfil, n, resid, ndigit,
& '_getv0: initial / restarted starting vector')
end if
ido = 99
c
call arscnd (t1)
tgetv0 = tgetv0 + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of psgetv0 |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdnapps.f 0000644 0001750 0001750 00000056234 12277373057 014503 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdnapps
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge chage sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pdnapps
c ( COMM, N, KEV, NP, SHIFTR, SHIFTI, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW. KEV is only
c updated on ouput when fewer than NP shifts are applied in
c order to keep the conjugate pair together.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFTR, Double precision array of length NP. (INPUT)
c SHIFTI Real and imaginary part of the shifts to be applied.
c Upon, entry to pdnapps, the shifts must be sorted so that the
c conjugate pairs are in consecutive locations.
c
c V Double precision N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenber matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Double precision KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKL Double precision work array of length (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Double precision work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c dlabad LAPACK routine that computes machine constants.
c dlacpy LAPACK matrix copy routine.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c dlarf LAPACK routine that applies Householder reflection to
c a matrix.
c dlarfg LAPACK Householder reflection construction routine.
c dlartg LAPACK Givens rotation construction routine.
c dlaset LAPACK matrix initialization routine.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dcopy Level 1 BLAS that copies one vector to another .
c dscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: napps.F SID: 2.2
c
c\SCCS Information:
c FILE: napps.F SID: 1.5 DATE OF SID: 03/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine dlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c The subdiagonals of H are enforced to be non-negative.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnapps
& ( comm, n, kev, np, shiftr, shifti, v, ldv, h, ldh, resid,
& q, ldq, workl, workd )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& h(ldh,kev+np), resid(n), shifti(np), shiftr(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, ir, istart, j, jj, kplusp, msglvl, nr
logical cconj, first
Double precision
& c, f, g, h11, h12, h21, h22, h32, ovfl, r, s, sigmai,
& sigmar, smlnum, ulp, unfl, u(3), t, tau, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dlacpy, dlarf, dlarfg, dlartg,
& dlaset, dlabad, arscnd, pivout, pdvout, pdmout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch, dlanhs, dlapy2
external pdlamch, dlanhs, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, max, min
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------------%
c
unfl = pdlamch( comm, 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call dlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
cconj = .false.
do 110 jj = 1, np
sigmar = shiftr(jj)
sigmai = shifti(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pdvout (comm, logfil, 1, sigmar, ndigit,
& '_napps: The real part of the shift ')
call pdvout (comm, logfil, 1, sigmai, ndigit,
& '_napps: The imaginary part of the shift ')
end if
c
c %-------------------------------------------------%
c | The following set of conditionals is necessary |
c | in order that complex conjugate pairs of shifts |
c | are applied together or not at all. |
c %-------------------------------------------------%
c
if ( cconj ) then
c
c %-----------------------------------------%
c | cconj = .true. means the previous shift |
c | had non-zero imaginary part. |
c %-----------------------------------------%
c
cconj = .false.
go to 110
else if ( jj .lt. np .and. abs( sigmai ) .gt. zero ) then
c
c %------------------------------------%
c | Start of a complex conjugate pair. |
c %------------------------------------%
c
cconj = .true.
else if ( jj .eq. np .and. abs( sigmai ) .gt. zero ) then
c
c %----------------------------------------------%
c | The last shift has a nonzero imaginary part. |
c | Don't apply it; thus the order of the |
c | compressed H is order KEV+1 since only np-1 |
c | were applied. |
c %----------------------------------------------%
c
kev = kev + 1
go to 110
end if
istart = 1
20 continue
c
c %--------------------------------------------------%
c | if sigmai = 0 then |
c | Apply the jj-th shift ... |
c | else |
c | Apply the jj-th and (jj+1)-th together ... |
c | (Note that jj < np at this point in the code) |
c | end |
c | to the current block of H. The next do loop |
c | determines the current block ; |
c %--------------------------------------------------%
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %----------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kplusp-jj+1, h, ldh, workl )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pdvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c %------------------------------------------------%
c
if ( istart .eq. iend ) go to 100
c
c %------------------------------------------------------%
c | If istart + 1 = iend then no reason to apply a |
c | complex conjugate pair of shifts on a 2 by 2 matrix. |
c %------------------------------------------------------%
c
if ( istart + 1 .eq. iend .and. abs( sigmai ) .gt. zero )
& go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
if ( abs( sigmai ) .le. zero ) then
c
c %---------------------------------------------%
c | Real-valued shift ==> apply single shift QR |
c %---------------------------------------------%
c
f = h11 - sigmar
g = h21
c
do 80 i = istart, iend-1
c
c %-----------------------------------------------------%
c | Contruct the plane rotation G to zero out the bulge |
c %-----------------------------------------------------%
c
call dlartg (f, g, c, s, r)
if (i .gt. istart) then
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -s*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + s*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-----------------------------------%
c | Finished applying the real shift. |
c %-----------------------------------%
c
else
c
c %----------------------------------------------------%
c | Complex conjugate shifts ==> apply double shift QR |
c %----------------------------------------------------%
c
h12 = h(istart,istart+1)
h22 = h(istart+1,istart+1)
h32 = h(istart+2,istart+1)
c
c %---------------------------------------------------------%
c | Compute 1st column of (H - shift*I)*(H - conj(shift)*I) |
c %---------------------------------------------------------%
c
s = 2.0*sigmar
t = dlapy2 ( sigmar, sigmai )
u(1) = ( h11 * (h11 - s) + t * t ) / h21 + h12
u(2) = h11 + h22 - s
u(3) = h32
c
do 90 i = istart, iend-1
c
nr = min ( 3, iend-i+1 )
c
c %-----------------------------------------------------%
c | Construct Householder reflector G to zero out u(1). |
c | G is of the form I - tau*( 1 u )' * ( 1 u' ). |
c %-----------------------------------------------------%
c
call dlarfg ( nr, u(1), u(2), 1, tau )
c
if (i .gt. istart) then
h(i,i-1) = u(1)
h(i+1,i-1) = zero
if (i .lt. iend-1) h(i+2,i-1) = zero
end if
u(1) = one
c
c %--------------------------------------%
c | Apply the reflector to the left of H |
c %--------------------------------------%
c
call dlarf ('Left', nr, kplusp-i+1, u, 1, tau,
& h(i,i), ldh, workl)
c
c %---------------------------------------%
c | Apply the reflector to the right of H |
c %---------------------------------------%
c
ir = min ( i+3, iend )
call dlarf ('Right', ir, nr, u, 1, tau,
& h(1,i), ldh, workl)
c
c %-----------------------------------------------------%
c | Accumulate the reflector in the matrix Q; Q <- Q*G |
c %-----------------------------------------------------%
c
call dlarf ('Right', kplusp, nr, u, 1, tau,
& q(1,i), ldq, workl)
c
c %----------------------------%
c | Prepare for next reflector |
c %----------------------------%
c
if (i .lt. iend-1) then
u(1) = h(i+1,i)
u(2) = h(i+2,i)
if (i .lt. iend-2) u(3) = h(i+3,i)
end if
c
90 continue
c
c %--------------------------------------------%
c | Finished applying a complex pair of shifts |
c | to the current block |
c %--------------------------------------------%
c
end if
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %--------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that H will have non negative sub diagonals |
c %--------------------------------------------------%
c
do 120 j=1,kev
if ( h(j+1,j) .lt. zero ) then
call dscal( kplusp-j+1, -one, h(j+1,j), ldh )
call dscal( min(j+2, kplusp), -one, h(1,j+1), 1 )
call dscal( min(j+np+1,kplusp), -one, q(1,j+1), 1 )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', kev, h, ldh, workl )
if( h( i+1,i ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call dgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call dcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call dlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if (h(kev+1,kev) .gt. zero)
& call dcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %---------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kplusp}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %---------------------------------------%
c
call dscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,kev) .gt. zero)
& call daxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pdvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pdmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tnapps = tnapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pdnapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pznapps.f 0000644 0001750 0001750 00000043237 12277373057 014530 0000000 0000000 c\BeginDoc
c
c\Name: pznapps
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP implicit shifts resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix which is the product of rotations
c and reflections resulting from the NP bulge change sweeps.
c The updated Arnoldi factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pznapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ,
c WORKL, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. size of matrix A.
c
c KEV Integer. (INPUT/OUTPUT)
c KEV+NP is the size of the input matrix H.
c KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Complex*16 array of length NP. (INPUT)
c The shifts to be applied.
c
c V Complex*16 N by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, V contains the current KEV+NP Arnoldi vectors.
c On OUTPUT, V contains the updated KEV Arnoldi vectors
c in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (KEV+NP) by (KEV+NP) array. (INPUT/OUTPUT)
c On INPUT, H contains the current KEV+NP by KEV+NP upper
c Hessenberg matrix of the Arnoldi factorization.
c On OUTPUT, H contains the updated KEV by KEV upper Hessenberg
c matrix in the KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT, RESID contains the the residual vector r_{k+p}.
c On OUTPUT, RESID is the update residual vector rnew_{k}
c in the first KEV locations.
c
c Q Complex*16 KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations and reflections
c during the bulge chase sweep.
c
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 (KEV+NP). (WORKSPACE)
c Private (replicated) array on each PE or array allocated on
c the front end.
c
c WORKD Complex*16 work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zlacpy LAPACK matrix copy routine.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlartg LAPACK Givens rotation construction routine.
c zlaset LAPACK matrix initialization routine.
c dlabad LAPACK routine for defining the underflow and overflow
c limits.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
c zcopy Level 1 BLAS that copies one vector to another.
c zscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: napps.F SID: 2.1
c
c\SCCS Information:
c FILE: napps.F SID: 1.4 DATE OF SID: 10/25/03
c
c\Remarks
c 1. In this version, each shift is applied to all the sublocks of
c the Hessenberg matrix H and not just to the submatrix that it
c comes from. Deflation as in LAPACK routine zlahqr (QR algorithm
c for upper Hessenberg matrices ) is used.
c Upon output, the subdiagonals of H are enforced to be non-negative
c real numbers.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq,
& workl, workd )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& h(ldh,kev+np), resid(n), shift(np),
& v(ldv,kev+np), q(ldq,kev+np), workd(2*n), workl(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rzero = 0.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
integer i, iend, istart, j, jj, kplusp, msglvl
logical first
Complex*16
& cdum, f, g, h11, h21, r, s, sigma, t
Double precision
& c, ovfl, smlnum, ulp, unfl, tst1
save first, ovfl, smlnum, ulp, unfl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zgemv, zscal, zlacpy, zlartg,
& pzvout, zlaset, dlabad, pzmout, arscnd, pivout
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& zlanhs, pdlamch, dlapy2
external zlanhs, pdlamch, dlapy2
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, dimag, conjg, dcmplx, max, min, dble
c
c %---------------------%
c | Statement Functions |
c %---------------------%
c
Double precision
& cabs1
cabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------------%
c | Set machine-dependent constants for the |
c | stopping criterion. If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------------%
c
unfl = pdlamch( comm, 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = dlamch( 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcapps
c
kplusp = kev + np
c
c %--------------------------------------------%
c | Initialize Q to the identity to accumulate |
c | the rotations and reflections |
c %--------------------------------------------%
c
call zlaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------%
c | Chase the bulge with the application of each |
c | implicit shift. Each shift is applied to the |
c | whole matrix including each block. |
c %----------------------------------------------%
c
do 110 jj = 1, np
sigma = shift(jj)
c
if (msglvl .gt. 2 ) then
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: shift number.')
call pzvout (comm, logfil, 1, sigma, ndigit,
& '_napps: Value of the shift ')
end if
c
istart = 1
20 continue
c
do 30 i = istart, kplusp-1
c
c %----------------------------------------%
c | Check for splitting and deflation. Use |
c | a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %----------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1.eq.rzero )
& tst1 = zlanhs( '1', kplusp-jj+1, h, ldh, workl )
if ( abs(dble(h(i+1,i)))
& .le. max(ulp*tst1, smlnum) ) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_napps: matrix splitting at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_napps: matrix splitting with shift number.')
call pzvout (comm, logfil, 1, h(i+1,i), ndigit,
& '_napps: off diagonal element.')
end if
iend = i
h(i+1,i) = zero
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, istart, ndigit,
& '_napps: Start of current block ')
call pivout (comm, logfil, 1, iend, ndigit,
& '_napps: End of current block ')
end if
c
c %------------------------------------------------%
c | No reason to apply a shift to block of order 1 |
c | or if the current block starts after the point |
c | of compression since we'll discard this stuff |
c %------------------------------------------------%
c
if ( istart .eq. iend .or. istart .gt. kev) go to 100
c
h11 = h(istart,istart)
h21 = h(istart+1,istart)
f = h11 - sigma
g = h21
c
do 80 i = istart, iend-1
c
c %------------------------------------------------------%
c | Construct the plane rotation G to zero out the bulge |
c %------------------------------------------------------%
c
call zlartg (f, g, c, s, r)
if (i .gt. istart) then
h(i,i-1) = r
h(i+1,i-1) = zero
end if
c
c %---------------------------------------------%
c | Apply rotation to the left of H; H <- G'*H |
c %---------------------------------------------%
c
do 50 j = i, kplusp
t = c*h(i,j) + s*h(i+1,j)
h(i+1,j) = -conjg(s)*h(i,j) + c*h(i+1,j)
h(i,j) = t
50 continue
c
c %---------------------------------------------%
c | Apply rotation to the right of H; H <- H*G |
c %---------------------------------------------%
c
do 60 j = 1, min(i+2,iend)
t = c*h(j,i) + conjg(s)*h(j,i+1)
h(j,i+1) = -s*h(j,i) + c*h(j,i+1)
h(j,i) = t
60 continue
c
c %-----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G' |
c %-----------------------------------------------------%
c
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
70 continue
c
c %---------------------------%
c | Prepare for next rotation |
c %---------------------------%
c
if (i .lt. iend-1) then
f = h(i+1,i)
g = h(i+2,i)
end if
80 continue
c
c %-------------------------------%
c | Finished applying the shift. |
c %-------------------------------%
c
100 continue
c
c %---------------------------------------------------------%
c | Apply the same shift to the next block if there is any. |
c %---------------------------------------------------------%
c
istart = iend + 1
if (iend .lt. kplusp) go to 20
c
c %---------------------------------------------%
c | Loop back to the top to get the next shift. |
c %---------------------------------------------%
c
110 continue
c
c %---------------------------------------------------%
c | Perform a similarity transformation that makes |
c | sure that the compressed H will have non-negative |
c | real subdiagonal elements. |
c %---------------------------------------------------%
c
do 120 j=1,kev
if ( dble( h(j+1,j) ) .lt. rzero .or.
& dimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / dlapy2(dble(h(j+1,j)),dimag(h(j+1,j)))
call zscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call zscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call zscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = dcmplx( dble( h(j+1,j) ), rzero )
end if
120 continue
c
do 130 i = 1, kev
c
c %--------------------------------------------%
c | Final check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr. |
c | Note: Since the subdiagonals of the |
c | compressed H are nonnegative real numbers, |
c | we take advantage of this. |
c %--------------------------------------------%
c
tst1 = cabs1( h( i, i ) ) + cabs1( h( i+1, i+1 ) )
if( tst1 .eq. rzero )
& tst1 = zlanhs( '1', kev, h, ldh, workl )
if( dble( h( i+1,i ) ) .le. max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
130 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is needed in the residual update since we |
c | cannot GUARANTEE that the corresponding entry |
c | of H would be zero as in exact arithmetic. |
c %-------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zgemv ('N', n, kplusp, one, v, ldv, q(1,kev+1), 1, zero,
& workd(n+1), 1)
c
c %----------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage of the upper Hessenberg structure of Q. |
c %----------------------------------------------------------%
c
do 140 i = 1, kev
call zgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call zcopy (n, workd, 1, v(1,kplusp-i+1), 1)
140 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call zlacpy ('A', n, kev, v(1,kplusp-kev+1), ldv, v, ldv)
c
c %--------------------------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the appropriate place |
c %--------------------------------------------------------------%
c
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zcopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call zscal (n, q(kplusp,kev), resid, 1)
if ( dble( h(kev+1,kev) ) .gt. rzero )
& call zaxpy (n, h(kev+1,kev), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call pzvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_napps: sigmak = (e_{kev+p}^T*Q)*e_{kev}')
call pzvout (comm, logfil, 1, h(kev+1,kev), ndigit,
& '_napps: betak = e_{kev+1}^T*H*e_{kev}')
call pivout (comm, logfil, 1, kev, ndigit,
& '_napps: Order of the final Hessenberg matrix ')
if (msglvl .gt. 2) then
call pzmout (comm, logfil, kev, kev, h, ldh, ndigit,
& '_napps: updated Hessenberg matrix H for next iteration')
end if
c
end if
c
9000 continue
call arscnd (t1)
tcapps = tcapps + (t1 - t0)
c
return
c
c %----------------%
c | End of pznapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdnorm2.f 0000644 0001750 0001750 00000003516 12277373057 014412 0000000 0000000 c\BeginDoc
c
c\Name: pdnorm2
c
c Message Passing Layer: BLACS
c
c\Description:
c
c\Usage:
c call pdnorm2 ( COMM, N, X, INC )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c\SCCS Information:
c FILE: norm2.F SID: 1.2 DATE OF SID: 2/22/96
c
c-----------------------------------------------------------------------
c
Double precision function pdnorm2 ( comm, n, x, inc )
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d, dgamx2d
c
c %------------------%
c | Scalar Arguments |
c %------------------%
c
integer n, inc
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Double precision
& x(n)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
Double precision
& max, buf, zero
parameter ( zero = 0.0 )
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dnrm2
External dnrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
pdnorm2 = dnrm2( n, x, inc)
c
max = pdnorm2
call dgamx2d( comm, 'All', ' ', 1, 1, max, 1, ra, ca,
& -1, -1, -1 )
if ( max .eq. zero ) then
pdnorm2 = zero
else
pdnorm2 = (pdnorm2/max)**2.0
call dgsum2d( comm, 'All', ' ', 1, 1, pdnorm2, 1, -1, -1 )
pdnorm2 = max * sqrt(abs(pdnorm2))
endif
c
c %----------------%
c | End of pdnorm2 |
c %----------------%
c
return
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psnaupd.f 0000644 0001750 0001750 00000073170 12277373057 014506 0000000 0000000 c\BeginDoc
c
c\Name: psnaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for the Implicitly Restarted Arnoldi
c iteration. This subroutine computes approximations to a few eigenpairs
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c psnaupd is usually called iteratively to solve one of the
c following problems:
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 ===> 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 ===> OP = Real_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2 * [ 1/(lambda-sigma) + 1/(lambda-conjg(sigma)) ].
c Note: If sigma is real, i.e. imaginary part of sigma is zero;
c Real_Part{ inv[A - sigma*M]*M } == inv[A - sigma*M]*M
c amu == 1/(lambda-sigma).
c
c Mode 4: A*x = lambda*M*x, M symmetric semi-definite
c ===> OP = Imaginary_Part{ inv[A - sigma*M]*M } and B = M.
c ===> shift-and-invert mode (in real arithmetic)
c If OP*x = amu*x, then
c amu = 1/2i * [ 1/(lambda-sigma) - 1/(lambda-conjg(sigma)) ].
c
c Both mode 3 and 4 give the same enhancement to eigenvalues close to
c the (complex) shift sigma. However, as lambda goes to infinity,
c the operator OP in mode 4 dampens the eigenvalues more strongly than
c does OP defined in mode 3.
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call psnaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to psnaupd. 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 psnaupd with the result. The operand is given in
c WORKD(IPNTR(1)), the result must be put in WORKD(IPNTR(2)).
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3 and 4, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) real and imaginary parts
c of the shifts where INPTR(14) is the pointer
c into WORKL for placing the shifts. See Remark
c 5 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c BMAT = 'I' -> standard eigenvalue problem A*x = lambda*x
c BMAT = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c 'LM' -> want the NEV eigenvalues of largest magnitude.
c 'SM' -> want the NEV eigenvalues of smallest magnitude.
c 'LR' -> want the NEV eigenvalues of largest real part.
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 Number of eigenvalues of OP to be computed. 0 < NEV < N-1.
c
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 where ABS(RITZ(I)) is the magnitude when RITZ(I) is complex.
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 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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V. NCV must satisfy the two
c inequalities 2 <= NCV-NEV and NCV <= N.
c This will indicate how many Arnoldi vectors are generated
c at each iteration. After the startup phase in which NEV
c Arnoldi vectors are generated, the algorithm generates
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 NOTE: 2 <= NCV-NEV in order that complex conjugate pairs of Ritz
c values are kept together. (See remark 4 below)
c
c V Real array N by NCV. (OUTPUT)
c Contains the final set of Arnoldi basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The real and imaginary
c parts of the NCV eigenvalues of the Hessenberg
c matrix H are returned in the part of the WORKL
c array corresponding to RITZR and RITZI. See remark
c 5 below.
c ISHIFT = 1: exact shifts with respect to the current
c Hessenberg matrix H. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of approximate Schur
c vectors associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = No longer referenced.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 psnaupd for the
c four modes available.
c
c IPARAM(8) = NP
c When ido = 3 and the user provides shifts through reverse
c communication (IPARAM(1)=0), psnaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 5 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 14. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by NCV upper Hessenberg matrix
c H in WORKL.
c IPNTR(6): pointer to the real part of the ritz value array
c RITZR in WORKL.
c IPNTR(7): pointer to the imaginary part of the ritz value array
c RITZI in WORKL.
c IPNTR(8): pointer to the Ritz estimates in array WORKL associated
c with the Ritz values located in RITZR and RITZI in WORKL.
c IPNTR(14): pointer to the NP shifts in WORKL. See Remark 5 below.
c
c Note: IPNTR(9:13) is only referenced by sneupd. See Remark 2 below.
c
c IPNTR(9): pointer to the real part of the NCV RITZ values of the
c original system.
c IPNTR(10): pointer to the imaginary part of the NCV RITZ values of
c the original system.
c IPNTR(11): pointer to the NCV corresponding error bounds.
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 psneupd if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
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
c WORKD(1:N) contains B*RESID(1:N). If an invariant subspace
c associated with the converged Ritz values is desired, see remark
c 2 below, subroutine sneupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least 3*NCV**2 + 6*NCV.
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 = -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'
c = -6: BMAT must be one of 'I' or 'G'.
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,4.
c = -11: IPARAM(7) = 1 and BMAT = 'G' are incompatable.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization.
c
c\Remarks
c 1. The computed Ritz values are approximate eigenvalues of OP. The
c selection of WHICH should be made with this in mind when
c Mode = 3 and 4. After convergence, approximate eigenvalues of the
c original problem may be obtained with the ARPACK subroutine sneupd.
c
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 psnaupd. This is new starting with release 2 of ARPACK.
c
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 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
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.
c However, it is recommended that NCV .ge. 2*NEV+1. 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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c See Chapter 8 of Reference 2 for further information.
c
c 5. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) real and imaginary parts of the shifts in locations
c real part imaginary part
c ----------------------- --------------
c 1 WORKL(IPNTR(14)) WORKL(IPNTR(14)+NP)
c 2 WORKL(IPNTR(14)+1) WORKL(IPNTR(14)+NP+1)
c . .
c . .
c . .
c NP WORKL(IPNTR(14)+NP-1) WORKL(IPNTR(14)+2*NP-1).
c
c Only complex conjugate pairs of shifts may be applied and the pairs
c must be placed in consecutive locations. The real part of the
c eigenvalues of the current upper Hessenberg matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1) and the imaginary part
c in WORKL(IPNTR(7)) through WORKL(IPNTR(7)+NCV-1). They are ordered
c according to the order defined by WHICH. The complex conjugate
c pairs are kept together and the associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c Real resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c decompose d1(n), d2(n,ncv)
c align resid(i) with d1(i)
c align v(i,j) with d2(i,j)
c align workd(i) with d1(i) range (1:n)
c align workd(i) with d1(i-n) range (n+1:2*n)
c align workd(i) with d1(i-2*n) range (2*n+1:3*n)
c distribute d1(block), d2(block,:)
c replicated workl(lworkl)
c
c Cray MPP syntax:
c ===============
c Real resid(n), v(ldv,ncv), workd(n,3), workl(lworkl)
c shared resid(block), v(block,:), workd(block,:)
c replicated workl(lworkl)
c
c CM2/CM5 syntax:
c ==============
c
c-----------------------------------------------------------------------
c
c include 'ex-nonsym.doc'
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett & Y. Saad, "Complex Shift and Invert Strategies for
c Real Matrices", Linear Algebra and its Applications, vol 88/89,
c pp 575-595, (1987).
c
c\Routines called:
c psnaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c
c\Author
c Danny Sorensen Phuong Vu
c Richard Lehoucq Cray Research, Inc. &
c Dept. of Computational & CRPC / Rice University
c Applied Mathematics Houston, Texas
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naupd.F SID: 2.2
c
c\SCCS Information:
c FILE: naupd.F SID: 1.9 DATE OF SID: 04/10/01
c
c\Remarks
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
Real
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, levec, mode, msglvl, mxiter, nb,
& nev0, next, np, ritzi, ritzr, j
save bounds, ih, iq, ishift, iupd, iw, ldh, ldq,
& levec, mode, msglvl, mxiter, nb, nev0, next,
& np, ritzi, ritzr
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external psnaup2, psvout, pivout, arscnd, sstatn
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call sstatn
call arscnd (t0)
msglvl = mnaupd
c
c %----------------%
c | Error checking |
c %----------------%
c
ierr = 0
ishift = iparam(1)
c levec = iparam(2)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1) then
ierr = -3
else if (mxiter .le. 0) then
ierr = -4
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 6*ncv) then
ierr = -7
else if (mode .lt. 1 .or. mode .gt. 4) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pslamch(comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, 3*ncv**2 + 6*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+2*ncv) := real and imaginary |
c | parts of ritz values |
c | workl(ncv*ncv+2*ncv+1:ncv*ncv+3*ncv) := error bounds |
c | workl(ncv*ncv+3*ncv+1:2*ncv*ncv+3*ncv) := rotation matrix Q |
c | workl(2*ncv*ncv+3*ncv+1:3*ncv*ncv+6*ncv) := workspace |
c | The final workspace is needed by subroutine psneigh called |
c | by psnaup2. Subroutine sneigh calls LAPACK routines for |
c | calculating eigenvalues and the last row of the eigenvector |
c | matrix. |
c %-------------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritzr = ih + ldh*ncv
ritzi = ritzr + ncv
bounds = ritzi + ncv
iq = bounds + ncv
iw = iq + ldq*ncv
next = iw + ncv**2 + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritzr
ipntr(7) = ritzi
ipntr(8) = bounds
ipntr(14) = iw
c
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Arnoldi Iteration. |
c %-------------------------------------------------------%
c
call psnaup2
& ( comm, ido, bmat, n, which, nev0, np, tol, resid, mode, iupd,
& ishift, mxiter, v, ldv, workl(ih), ldh, workl(ritzr),
& workl(ritzi), workl(bounds), workl(iq), ldq, workl(iw),
& ipntr, workd, info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within psnaup2. |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_naupd: Number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_naupd: Number of wanted "converged" Ritz values')
call psvout (comm, logfil, np, workl(ritzr), ndigit,
& '_naupd: Real part of the final Ritz values')
call psvout (comm, logfil, np, workl(ritzi), ndigit,
& '_naupd: Imaginary part of the final Ritz values')
call psvout (comm, logfil, np, workl(bounds), ndigit,
& '_naupd: Associated Ritz estimates')
end if
c
call arscnd (t1)
tnaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tnaupd, tnaup2, tnaitr, titref,
& tgetv0, tneigh, tngets, tnapps, tnconv, trvec
1000 format (//,
& 5x, '=============================================',/
& 5x, '= Nonsymmetric implicit Arnoldi update code =',/
& 5x, '= Version Number: ', ' 2.1' , 21x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 16x, ' =',/
& 5x, '=============================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '=============================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_naup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in Hessenberg eig. subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6,/
& 5x, 'Total time in computing final Ritz vectors = ', f12.6/)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of psnaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdsaupd.f 0000644 0001750 0001750 00000071764 12277373057 014503 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaupd
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Reverse communication interface for the Implicitly Restarted Arnoldi
c Iteration. For symmetric problems this reduces to a variant of the Lanczos
c method. This method has been designed to compute approximations to a
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
c Another way to express this condition is
c
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
c The computed approximate eigenvalues are called Ritz values and
c the corresponding approximate eigenvectors are called Ritz vectors.
c
c pdsaupd is usually called iteratively to solve one of the
c following problems:
c
c Mode 1: A*x = lambda*x, A symmetric
c ===> OP = A and B = I.
c
c Mode 2: A*x = lambda*M*x, A symmetric, M symmetric positive definite
c ===> OP = inv[M]*A and B = M.
c ===> (If M can be factored see remark 3 below)
c
c Mode 3: K*x = lambda*M*x, K symmetric, M symmetric positive semi-definite
c ===> OP = (inv[K - sigma*M])*M and B = M.
c ===> Shift-and-Invert mode
c
c Mode 4: K*x = lambda*KG*x, K symmetric positive semi-definite,
c KG symmetric indefinite
c ===> OP = (inv[K - sigma*KG])*K and B = K.
c ===> Buckling mode
c
c Mode 5: A*x = lambda*M*x, A symmetric, M symmetric positive semi-definite
c ===> OP = inv[A - sigma*M]*[A + sigma*M] and B = M.
c ===> Cayley transformed mode
c
c NOTE: The action of w <- inv[A - sigma*M]*v or w <- inv[M]*v
c should be accomplished either by a direct method
c using a sparse matrix factorization and solving
c
c [A - sigma*M]*w = v or M*w = v,
c
c or through an iterative method for solving these
c systems. If an iterative method is used, the
c convergence test must be more stringent than
c the accuracy requirements for the eigenvalue
c approximations.
c
c\Usage:
c call pdsaupd
c ( COMM, IDO, BMAT, N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM,
c IPNTR, WORKD, WORKL, LWORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag. IDO must be zero on the first
c call to pdsaupd . 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 pdsaupd 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 -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c This is for the initialization phase to force the
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c In mode 3,4 and 5, the vector B * X is already
c available in WORKD(ipntr(3)). It does not
c need to be recomputed in forming OP * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORKD for X,
c IPNTR(2) is the pointer into WORKD for Y.
c IDO = 3: compute the IPARAM(8) shifts where
c IPNTR(11) is the pointer into WORKL for
c placing the shifts. See remark 6 below.
c IDO = 99: done
c -------------------------------------------------------------
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*B*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c WHICH Character*2. (INPUT)
c Specify which of the Ritz values of OP to compute.
c
c 'LA' - compute the NEV largest (algebraic) eigenvalues.
c 'SA' - compute the NEV smallest (algebraic) eigenvalues.
c 'LM' - compute the NEV largest (in magnitude) eigenvalues.
c 'SM' - compute the NEV smallest (in magnitude) eigenvalues.
c 'BE' - compute NEV eigenvalues, half from each end of the
c spectrum. When NEV is odd, compute one more from the
c high end than from the low end.
c (see remark 1 below)
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 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
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,
c possibly from a previous run.
c On OUTPUT:
c RESID contains the final residual vector.
c
c NCV Integer. (INPUT)
c Number of columns of the matrix V (less than or equal to N).
c This will indicate how many Lanczos vectors are generated
c at each iteration. After the startup phase in which NEV
c Lanczos vectors are generated, the algorithm generates
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 The NCV columns of V contain the Lanczos basis vectors.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c IPARAM Integer array of length 11. (INPUT/OUTPUT)
c IPARAM(1) = ISHIFT: method for selecting the implicit shifts.
c The shifts selected at each iteration are used to restart
c the Arnoldi iteration in an implicit fashion.
c -------------------------------------------------------------
c ISHIFT = 0: the shifts are provided by the user via
c reverse communication. The NCV eigenvalues of
c the current tridiagonal matrix T are returned in
c the part of WORKL array corresponding to RITZ.
c See remark 6 below.
c ISHIFT = 1: exact shifts with respect to the reduced
c tridiagonal matrix T. This is equivalent to
c restarting the iteration with a starting vector
c that is a linear combination of Ritz vectors
c associated with the "wanted" Ritz values.
c -------------------------------------------------------------
c
c IPARAM(2) = LEVEC
c No longer referenced. See remark 2 below.
c
c IPARAM(3) = MXITER
c On INPUT: maximum number of Arnoldi update iterations allowed.
c On OUTPUT: actual number of Arnoldi update iterations taken.
c
c IPARAM(4) = NB: blocksize to be used in the recurrence.
c The code currently works only for NB = 1.
c
c IPARAM(5) = NCONV: number of "converged" Ritz values.
c This represents the number of Ritz values that satisfy
c the convergence criterion.
c
c IPARAM(6) = IUPD
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 pdsaupd 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), pdsaupd returns NP, the number
c of shifts the user is to provide. 0 < NP <=NCV-NEV. See Remark
c 6 below.
c
c IPARAM(9) = NUMOP, IPARAM(10) = NUMOPB, IPARAM(11) = NUMREO,
c OUTPUT: NUMOP = total number of OP*x operations,
c NUMOPB = total number of B*x operations if BMAT='G',
c NUMREO = total number of steps of re-orthogonalization.
c
c IPNTR Integer array of length 11. (OUTPUT)
c Pointer to mark the starting locations in the WORKD and WORKL
c arrays for matrices/vectors used by the Lanczos iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X in WORKD.
c IPNTR(2): pointer to the current result vector Y in WORKD.
c IPNTR(3): pointer to the vector B * X in WORKD when used in
c the shift-and-invert mode.
c IPNTR(4): pointer to the next available location in WORKL
c that is untouched by the program.
c IPNTR(5): pointer to the NCV by 2 tridiagonal matrix T in WORKL.
c IPNTR(6): pointer to the NCV RITZ values array in WORKL.
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 pdseupd . 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 pdseupd if RVEC = .TRUE. See Remarks.
c -------------------------------------------------------------
c
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 pdseupd uses this output.
c See Data Distribution Note below.
c
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
c LWORKL Integer. (INPUT)
c LWORKL must be at least NCV**2 + 8*NCV .
c
c INFO Integer. (INPUT/OUTPUT)
c If INFO .EQ. 0, a randomly initial residual vector is used.
c If INFO .NE. 0, RESID contains the initial residual vector,
c possibly from a previous run.
c Error flag on output.
c = 0: Normal exit.
c = 1: Maximum number of iterations taken.
c All possible eigenvalues of OP has been found. IPARAM(5)
c returns the number of wanted converged Ritz values.
c = 2: No longer an informational error. Deprecated starting
c with release 2 of ARPACK.
c = 3: No shifts could be applied during a cycle of the
c Implicitly restarted Arnoldi iteration. One possibility
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 must be greater than NEV and less than or equal to N.
c = -4: The maximum number of Arnoldi update iterations allowed
c must be greater than zero.
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 = -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.
c = -12: IPARAM(1) must be equal to 0 or 1.
c = -13: NEV and WHICH = 'BE' are incompatable.
c = -9999: Could not build an Arnoldi factorization.
c IPARAM(5) returns the size of the current Arnoldi
c factorization. The user is advised to check that
c enough workspace and array storage has been allocated.
c
c
c\Remarks
c 1. The converged Ritz values are always returned in ascending
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 pdseupd .
c
c 2. If the Ritz vectors corresponding to the converged Ritz values
c are needed, the user must call pdseupd immediately following completion
c of pdsaupd . 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 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 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
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.
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
c usually decrease the required number of OP*x operations but it
c also increases the work and storage required to maintain the orthogonal
c basis vectors. The optimal "cross-over" with respect to CPU time
c is problem dependent and must be determined empirically.
c
c 5. If IPARAM(7) = 2 then in the Reverse commuication interface the user
c must do the following. When IDO = 1, Y = OP * X is to be computed.
c When IPARAM(7) = 2 OP = inv(B)*A. After computing A*X the user
c must overwrite X with A*X. Y is then the solution to the linear set
c of equations B*Y = A*X.
c
c 6. When IPARAM(1) = 0, and IDO = 3, the user needs to provide the
c NP = IPARAM(8) shifts in locations:
c 1 WORKL(IPNTR(11))
c 2 WORKL(IPNTR(11)+1)
c .
c .
c .
c NP WORKL(IPNTR(11)+NP-1).
c
c The eigenvalues of the current tridiagonal matrix are located in
c WORKL(IPNTR(6)) through WORKL(IPNTR(6)+NCV-1). They are in the
c order defined by WHICH. The associated Ritz estimates are located in
c WORKL(IPNTR(8)), WORKL(IPNTR(8)+1), ... , WORKL(IPNTR(8)+NCV-1).
c
c-----------------------------------------------------------------------
c
c\Data Distribution Note:
c
c Fortran-D syntax:
c ================
c REAL RESID(N), V(LDV,NCV), WORKD(3*N), WORKL(LWORKL)
c DECOMPOSE D1(N), D2(N,NCV)
c ALIGN RESID(I) with D1(I)
c ALIGN V(I,J) with D2(I,J)
c ALIGN WORKD(I) with D1(I) range (1:N)
c ALIGN WORKD(I) with D1(I-N) range (N+1:2*N)
c ALIGN WORKD(I) with D1(I-2*N) range (2*N+1:3*N)
c DISTRIBUTE D1(BLOCK), D2(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c Cray MPP syntax:
c ===============
c REAL RESID(N), V(LDV,NCV), WORKD(N,3), WORKL(LWORKL)
c SHARED RESID(BLOCK), V(BLOCK,:), WORKD(BLOCK,:)
c REPLICATED WORKL(LWORKL)
c
c
c\BeginLib
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B.N. Parlett, "The Symmetric Eigenvalue Problem". Prentice-Hall,
c 1980.
c 4. B.N. Parlett, B. Nour-Omid, "Towards a Black Box Lanczos Program",
c Computer Physics Communications, 53 (1989), pp 169-179.
c 5. B. Nour-Omid, B.N. Parlett, T. Ericson, P.S. Jensen, "How to
c Implement the Spectral Transformation", Math. Comp., 48 (1987),
c pp 663-673.
c 6. R.G. Grimes, J.G. Lewis and H.D. Simon, "A Shifted Block Lanczos
c Algorithm for Solving Sparse Symmetric Generalized Eigenproblems",
c SIAM J. Matr. Anal. Apps., January (1993).
c 7. L. Reichel, W.B. Gragg, "Algorithm 686: FORTRAN Subroutines
c for Updating the QR decomposition", ACM TOMS, December 1990,
c Volume 16 Number 4, pp 369-377.
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 pdsaup2 Parallel ARPACK routine that implements the Implicitly Restarted
c Arnoldi Iteration.
c dstats ARPACK routine that initializes timing and other statistics
c variables.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c
c\Authors
c Kristi Maschhoff ( Parallel Code )
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saupd.F SID: 2.4
c
c\SCCS Information:
c FILE: saupd.F SID: 1.7 DATE OF SID: 04/10/01
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaupd
& ( comm, ido, bmat, n, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, info )
c
c
c %-----------------------------------%
c | BLACS processor info and Routines |
c %-----------------------------------%
c
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO
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
character bmat*1, which*2
integer ido, info, ldv, lworkl, n, ncv, nev
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(11)
Double precision
& resid(n), v(ldv,ncv), workd(3*n), workl(lworkl)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0 , zero = 0.0 )
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz, j
save bounds, ierr, ih, iq, ishift, iupd, iw,
& ldh, ldq, msglvl, mxiter, mode, nb,
& nev0, next, np, ritz
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pdsaup2 , pdvout , pivout, arscnd, dstats
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& pdlamch
external pdlamch
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call dstats
call arscnd (t0)
msglvl = msaupd
c
ierr = 0
ishift = iparam(1)
mxiter = iparam(3)
c nb = iparam(4)
nb = 1
c
c %--------------------------------------------%
c | Revision 2 performs only implicit restart. |
c %--------------------------------------------%
c
iupd = 1
mode = iparam(7)
c
c %----------------%
c | Error checking |
c %----------------%
c
if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev) then
ierr = -3
end if
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c %----------------------------------------------%
c
np = ncv - nev
c
if (mxiter .le. 0) ierr = -4
if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LA' .and.
& which .ne. 'SA' .and.
& which .ne. 'BE') ierr = -5
if (bmat .ne. 'I' .and. bmat .ne. 'G') ierr = -6
c
if (lworkl .lt. ncv**2 + 8*ncv) ierr = -7
if (mode .lt. 1 .or. mode .gt. 5) then
ierr = -10
else if (mode .eq. 1 .and. bmat .eq. 'G') then
ierr = -11
else if (ishift .lt. 0 .or. ishift .gt. 1) then
ierr = -12
else if (nev .eq. 1 .and. which .eq. 'BE') then
ierr = -13
end if
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
ido = 99
go to 9000
end if
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
if (nb .le. 0) nb = 1
if (tol .le. zero) tol = pdlamch (comm, 'EpsMach')
c
c %----------------------------------------------%
c | NP is the number of additional steps to |
c | extend the length NEV Lanczos factorization. |
c | NEV0 is the local variable designating the |
c | size of the invariant subspace desired. |
c %----------------------------------------------%
c
np = ncv - nev
nev0 = nev
c
c %-----------------------------%
c | Zero out internal workspace |
c %-----------------------------%
c
do 10 j = 1, ncv**2 + 8*ncv
workl(j) = zero
10 continue
c
c %-------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, BOUNDS, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:2*ncv) := generated tridiagonal matrix |
c | workl(2*ncv+1:2*ncv+ncv) := ritz values |
c | workl(3*ncv+1:3*ncv+ncv) := computed error bounds |
c | workl(4*ncv+1:4*ncv+ncv*ncv) := rotation matrix Q |
c | workl(4*ncv+ncv*ncv+1:7*ncv+ncv*ncv) := workspace |
c %-------------------------------------------------------%
c
ldh = ncv
ldq = ncv
ih = 1
ritz = ih + 2*ldh
bounds = ritz + ncv
iq = bounds + ncv
iw = iq + ncv**2
next = iw + 3*ncv
c
ipntr(4) = next
ipntr(5) = ih
ipntr(6) = ritz
ipntr(7) = bounds
ipntr(11) = iw
end if
c
c %-------------------------------------------------------%
c | Carry out the Implicitly restarted Lanczos Iteration. |
c %-------------------------------------------------------%
c
call pdsaup2
& ( comm, 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,
& info )
c
c %--------------------------------------------------%
c | ido .ne. 99 implies use of reverse communication |
c | to compute operations involving OP or shifts. |
c %--------------------------------------------------%
c
if (ido .eq. 3) iparam(8) = np
if (ido .ne. 99) go to 9000
c
iparam(3) = mxiter
iparam(5) = np
iparam(9) = nopx
iparam(10) = nbx
iparam(11) = nrorth
c
c %------------------------------------%
c | Exit if there was an informational |
c | error within pdsaup2 . |
c %------------------------------------%
c
if (info .lt. 0) go to 9000
if (info .eq. 2) info = 3
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, mxiter, ndigit,
& '_saupd: number of update iterations taken')
call pivout (comm, logfil, 1, np, ndigit,
& '_saupd: number of "converged" Ritz values')
call pdvout (comm, logfil, np, workl(Ritz), ndigit,
& '_saupd: final Ritz values')
call pdvout (comm, logfil, np, workl(Bounds), ndigit,
& '_saupd: corresponding error bounds')
end if
c
call arscnd (t1)
tsaupd = t1 - t0
c
if (msglvl .gt. 0) then
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
if ( (myprow .eq. 0) .and. (mypcol .eq. 0) ) then
c
c %--------------------------------------------------------%
c | Version Number & Version Date are defined in version.h |
c %--------------------------------------------------------%
c
write (6,1000)
write (6,1100) mxiter, nopx, nbx, nrorth, nitref, nrstrt,
& tmvopx, tmvbx, tsaupd, tsaup2, tsaitr, titref,
& tgetv0, tseigt, tsgets, tsapps, tsconv
1000 format (//,
& 5x, '==========================================',/
& 5x, '= Symmetric implicit Arnoldi update code =',/
& 5x, '= Version Number:', ' 2.1' , 19x, ' =',/
& 5x, '= Version Date: ', ' 3/19/97' , 14x, ' =',/
& 5x, '==========================================',/
& 5x, '= Summary of timing statistics =',/
& 5x, '==========================================',//)
1100 format (
& 5x, 'Total number update iterations = ', i5,/
& 5x, 'Total number of OP*x operations = ', i5,/
& 5x, 'Total number of B*x operations = ', i5,/
& 5x, 'Total number of reorthogonalization steps = ', i5,/
& 5x, 'Total number of iterative refinement steps = ', i5,/
& 5x, 'Total number of restart steps = ', i5,/
& 5x, 'Total time in user OP*x operation = ', f12.6,/
& 5x, 'Total time in user B*x operation = ', f12.6,/
& 5x, 'Total time in Arnoldi update routine = ', f12.6,/
& 5x, 'Total time in p_saup2 routine = ', f12.6,/
& 5x, 'Total time in basic Arnoldi iteration loop = ', f12.6,/
& 5x, 'Total time in reorthogonalization phase = ', f12.6,/
& 5x, 'Total time in (re)start vector generation = ', f12.6,/
& 5x, 'Total time in trid eigenvalue subproblem = ', f12.6,/
& 5x, 'Total time in getting the shifts = ', f12.6,/
& 5x, 'Total time in applying the shifts = ', f12.6,/
& 5x, 'Total time in convergence testing = ', f12.6)
end if
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pdsaupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcngets.f 0000644 0001750 0001750 00000013474 12277373057 014500 0000000 0000000 c\BeginDoc
c
c\Name: pcngets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pcngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex
c
c\Routines called:
c csortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pcvout Parallel ARPACK utility routine that prints vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: ngets.F SID: 2.1
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pcngets ( comm, ishift, which, kev, np, ritz, bounds)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pcvout, csortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call csortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pcnapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call csortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pcvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pcvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pcngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pssapps.f 0000644 0001750 0001750 00000044460 12277373057 014525 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pssapps
c
c\Description:
c Given the Arnoldi factorization
c
c A*V_{k} - V_{k}*H_{k} = r_{k+p}*e_{k+p}^T,
c
c apply NP shifts implicitly resulting in
c
c A*(V_{k}*Q) - (V_{k}*Q)*(Q^T* H_{k}*Q) = r_{k+p}*e_{k+p}^T * Q
c
c where Q is an orthogonal matrix of order KEV+NP. Q is the product of
c rotations resulting from the NP bulge chasing sweeps. The updated Arnoldi
c factorization becomes:
c
c A*VNEW_{k} - VNEW_{k}*HNEW_{k} = rnew_{k}*e_{k}^T.
c
c\Usage:
c call pssapps
c ( COMM, N, KEV, NP, SHIFT, V, LDV, H, LDH, RESID, Q, LDQ, WORKD )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c N Integer. (INPUT)
c Problem size, i.e. dimension of matrix A.
c
c KEV Integer. (INPUT)
c INPUT: KEV+NP is the size of the input matrix H.
c OUTPUT: KEV is the size of the updated matrix HNEW.
c
c NP Integer. (INPUT)
c Number of implicit shifts to be applied.
c
c SHIFT Real array of length NP. (INPUT)
c The shifts to be applied.
c
c V Real N by (KEV+NP) array. (INPUT/OUTPUT)
c INPUT: V contains the current KEV+NP Arnoldi vectors.
c OUTPUT: VNEW = V(1:n,1:KEV); the updated Arnoldi vectors
c are in the first KEV columns of V.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (KEV+NP) by 2 array. (INPUT/OUTPUT)
c INPUT: H contains the symmetric tridiagonal matrix of the
c Arnoldi factorization with the subdiagonal in the 1st column
c starting at H(2,1) and the main diagonal in the 2nd column.
c OUTPUT: H contains the updated tridiagonal matrix in the
c KEV leading submatrix.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c RESID Real array of length (N). (INPUT/OUTPUT)
c INPUT: RESID contains the the residual vector r_{k+p}.
c OUTPUT: RESID is the updated residual vector rnew_{k}.
c
c Q Real KEV+NP by KEV+NP work array. (WORKSPACE)
c Work array used to accumulate the rotations during the bulge
c chase sweep.
c
c LDQ Integer. (INPUT)
c Leading dimension of Q exactly as declared in the calling
c program.
c
c WORKD Real work array of length 2*N. (WORKSPACE)
c Distributed array used in the application of the accumulated
c orthogonal matrix Q.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c pslamch ScaLAPACK routine that determines machine constants.
c slartg LAPACK Givens rotation construction routine.
c slacpy LAPACK matrix copy routine.
c slaset LAPACK matrix initialization routine.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sapps.F SID: 2.4
c
c\SCCS Information:
c FILE: sapps.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c 1. In this version, each shift is applied to all the subblocks of
c the tridiagonal matrix H and not just to the submatrix that it
c comes from. This routine assumes that the subdiagonal elements
c of H that are stored in h(1:kev+np,1) are nonegative upon input
c and enforce this condition upon output. This version incorporates
c deflation. See code for documentation.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pssapps
& ( comm, n, kev, np, shift, v, ldv, h, ldh, resid, q, ldq, workd)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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 kev, ldh, ldq, ldv, n, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& h(ldh,2), q(ldq,kev+np), resid(n), shift(np),
& v(ldv,kev+np), workd(2*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, iend, istart, itop, j, jj, kplusp, msglvl
logical first
Real
& a1, a2, a3, a4, big, c, epsmch, f, g, r, s
save epsmch, first
c
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, slacpy, slartg, slaset, psvout,
& pivout, arscnd, sgemv
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& pslamch
external pslamch
c
c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs
c
c %----------------%
c | Data statments |
c %----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
epsmch = pslamch(comm, 'Epsilon-Machine')
first = .false.
end if
itop = 1
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msapps
c
kplusp = kev + np
c
c %----------------------------------------------%
c | Initialize Q to the identity matrix of order |
c | kplusp used to accumulate the rotations. |
c %----------------------------------------------%
c
call slaset ('All', kplusp, kplusp, zero, one, q, ldq)
c
c %----------------------------------------------%
c | Quick return if there are no shifts to apply |
c %----------------------------------------------%
c
if (np .eq. 0) go to 9000
c
c %----------------------------------------------------------%
c | Apply the np shifts implicitly. Apply each shift to the |
c | whole matrix and not just to the submatrix from which it |
c | comes. |
c %----------------------------------------------------------%
c
do 90 jj = 1, np
c
istart = itop
c
c %----------------------------------------------------------%
c | Check for splitting and deflation. Currently we consider |
c | an off-diagonal element h(i+1,1) negligible if |
c | h(i+1,1) .le. epsmch*( |h(i,2)| + |h(i+1,2)| ) |
c | for i=1:KEV+NP-1. |
c | If above condition tests true then we set h(i+1,1) = 0. |
c | Note that h(1:KEV+NP,1) are assumed to be non negative. |
c %----------------------------------------------------------%
c
20 continue
c
c %------------------------------------------------%
c | The following loop exits early if we encounter |
c | a negligible off diagonal element. |
c %------------------------------------------------%
c
do 30 i = istart, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call pivout (comm, logfil, 1, jj, ndigit,
& '_sapps: occured before shift number.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
iend = i
go to 40
end if
30 continue
iend = kplusp
40 continue
c
if (istart .lt. iend) then
c
c %--------------------------------------------------------%
c | Construct the plane rotation G'(istart,istart+1,theta) |
c | that attempts to drive h(istart+1,1) to zero. |
c %--------------------------------------------------------%
c
f = h(istart,2) - shift(jj)
g = h(istart+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G' * H * G, where G = G(istart,istart+1,theta). |
c | This will create a "bulge". |
c %-------------------------------------------------------%
c
a1 = c*h(istart,2) + s*h(istart+1,1)
a2 = c*h(istart+1,1) + s*h(istart+1,2)
a4 = c*h(istart+1,2) - s*h(istart+1,1)
a3 = c*h(istart+1,1) - s*h(istart,2)
h(istart,2) = c*a1 + s*a2
h(istart+1,2) = c*a4 - s*a3
h(istart+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
do 60 j = 1, min(istart+jj,kplusp)
a1 = c*q(j,istart) + s*q(j,istart+1)
q(j,istart+1) = - s*q(j,istart) + c*q(j,istart+1)
q(j,istart) = a1
60 continue
c
c
c %----------------------------------------------%
c | The following loop chases the bulge created. |
c | Note that the previous rotation may also be |
c | done within the following loop. But it is |
c | kept separate to make the distinction among |
c | the bulge chasing sweeps and the first plane |
c | rotation designed to drive h(istart+1,1) to |
c | zero. |
c %----------------------------------------------%
c
do 70 i = istart+1, iend-1
c
c %----------------------------------------------%
c | Construct the plane rotation G'(i,i+1,theta) |
c | that zeros the i-th bulge that was created |
c | by G(i-1,i,theta). g represents the bulge. |
c %----------------------------------------------%
c
f = h(i,1)
g = s*h(i+1,1)
c
c %----------------------------------%
c | Final update with G(i-1,i,theta) |
c %----------------------------------%
c
h(i+1,1) = c*h(i+1,1)
call slartg (f, g, c, s, r)
c
c %-------------------------------------------%
c | The following ensures that h(1:iend-1,1), |
c | the first iend-2 off diagonal of elements |
c | H, remain non negative. |
c %-------------------------------------------%
c
if (r .lt. zero) then
r = -r
c = -c
s = -s
end if
c
c %--------------------------------------------%
c | Apply rotation to the left and right of H; |
c | H <- G * H * G', where G = G(i,i+1,theta) |
c %--------------------------------------------%
c
h(i,1) = r
c
a1 = c*h(i,2) + s*h(i+1,1)
a2 = c*h(i+1,1) + s*h(i+1,2)
a3 = c*h(i+1,1) - s*h(i,2)
a4 = c*h(i+1,2) - s*h(i+1,1)
c
h(i,2) = c*a1 + s*a2
h(i+1,2) = c*a4 - s*a3
h(i+1,1) = c*a3 + s*a4
c
c %----------------------------------------------------%
c | Accumulate the rotation in the matrix Q; Q <- Q*G |
c %----------------------------------------------------%
c
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
50 continue
c
70 continue
c
end if
c
c %--------------------------%
c | Update the block pointer |
c %--------------------------%
c
istart = iend + 1
c
c %------------------------------------------%
c | Make sure that h(iend,1) is non-negative |
c | If not then set h(iend,1) <-- -h(iend,1) |
c | and negate the last column of Q. |
c | We have effectively carried out a |
c | similarity on transformation H |
c %------------------------------------------%
c
if (h(iend,1) .lt. zero) then
h(iend,1) = -h(iend,1)
call sscal(kplusp, -one, q(1,iend), 1)
end if
c
c %--------------------------------------------------------%
c | Apply the same shift to the next block if there is any |
c %--------------------------------------------------------%
c
if (iend .lt. kplusp) go to 20
c
c %-----------------------------------------------------%
c | Check if we can increase the the start of the block |
c %-----------------------------------------------------%
c
do 80 i = itop, kplusp-1
if (h(i+1,1) .gt. zero) go to 90
itop = itop + 1
80 continue
c
c %-----------------------------------%
c | Finished applying the jj-th shift |
c %-----------------------------------%
c
90 continue
c
c %------------------------------------------%
c | All shifts have been applied. Check for |
c | more possible deflation that might occur |
c | after the last shift is applied. |
c %------------------------------------------%
c
do 100 i = itop, kplusp-1
big = abs(h(i,2)) + abs(h(i+1,2))
if (h(i+1,1) .le. epsmch*big) then
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, i, ndigit,
& '_sapps: deflation at row/column no.')
call psvout (comm, logfil, 1, h(i+1,1), ndigit,
& '_sapps: the corresponding off diagonal element')
end if
h(i+1,1) = zero
end if
100 continue
c
c %-------------------------------------------------%
c | Compute the (kev+1)-st column of (V*Q) and |
c | temporarily store the result in WORKD(N+1:2*N). |
c | This is not necessary if h(kev+1,1) = 0. |
c %-------------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call sgemv ('N', n, kplusp, one, v, ldv,
& q(1,kev+1), 1, zero, workd(n+1), 1)
c
c %-------------------------------------------------------%
c | Compute column 1 to kev of (V*Q) in backward order |
c | taking advantage that Q is an upper triangular matrix |
c | with lower bandwidth np. |
c | Place results in v(:,kplusp-kev:kplusp) temporarily. |
c %-------------------------------------------------------%
c
do 130 i = 1, kev
call sgemv ('N', n, kplusp-i+1, one, v, ldv,
& q(1,kev-i+1), 1, zero, workd, 1)
call scopy (n, workd, 1, v(1,kplusp-i+1), 1)
130 continue
c
c %-------------------------------------------------%
c | Move v(:,kplusp-kev+1:kplusp) into v(:,1:kev). |
c %-------------------------------------------------%
c
call slacpy ('All', n, kev, v(1,np+1), ldv, v, ldv)
c
c %--------------------------------------------%
c | Copy the (kev+1)-st column of (V*Q) in the |
c | appropriate place if h(kev+1,1) .ne. zero. |
c %--------------------------------------------%
c
if ( h(kev+1,1) .gt. zero )
& call scopy (n, workd(n+1), 1, v(1,kev+1), 1)
c
c %-------------------------------------%
c | Update the residual vector: |
c | r <- sigmak*r + betak*v(:,kev+1) |
c | where |
c | sigmak = (e_{kev+p}'*Q)*e_{kev} |
c | betak = e_{kev+1}'*H*e_{kev} |
c %-------------------------------------%
c
call sscal (n, q(kplusp,kev), resid, 1)
if (h(kev+1,1) .gt. zero)
& call saxpy (n, h(kev+1,1), v(1,kev+1), 1, resid, 1)
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, 1, q(kplusp,kev), ndigit,
& '_sapps: sigmak of the updated residual vector')
call psvout (comm, logfil, 1, h(kev+1,1), ndigit,
& '_sapps: betak of the updated residual vector')
call psvout (comm, logfil, kev, h(1,2), ndigit,
& '_sapps: updated main diagonal of H for next iteration')
if (kev .gt. 1) then
call psvout (comm, logfil, kev-1, h(2,1), ndigit,
& '_sapps: updated sub diagonal of H for next iteration')
end if
end if
c
call arscnd (t1)
tsapps = tsapps + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pssapps |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdsaitr.f 0000644 0001750 0001750 00000076405 12277373057 014506 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdsaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step symmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pdsaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pdsaitr
c ( COMM, IDO, BMAT, N, K, NP, MODE, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and does not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of matrix B that defines the
c semi-inner product for the operator OP. See pdsaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M*x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current order of H and the number of columns of V.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c MODE Integer. (INPUT)
c Signifies which form for "OP". If MODE=2 then
c a reduction in the number of B matrix vector multiplies
c is possible since the B-norm of OP*x is equivalent to
c the inv(B)-norm of A*x.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c On INPUT the B-norm of r_{k}.
c On OUTPUT the B-norm of the updated residual r_{k+p}.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by 2 array. (INPUT/OUTPUT)
c H is used to store the generated symmetric tridiagonal matrix
c with the subdiagonal in the first column starting at H(2,1)
c and the main diagonal in the second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On INPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K step Arnoldi factorization. Used to save some
c computation at the first step.
c On OUTPUT, WORKD(1:N) = B*RESID where RESID is associated
c with the K+NP step Arnoldi factorization.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of an invariant subspace of OP is found that is
c less than K + NP.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c pdgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c pdmout Parallel ARPACK utility routine that prints matrices.
c pdvout Parallel ARPACK utility routine that prints vectors.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: saitr.F SID: 2.3
c
c\SCCS Information:
c FILE: saitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pdsaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c alphaj <- j-th component of w_{j}
c rnorm = || r_{j} ||
c betaj+1 = rnorm
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdsaitr
& (comm, ido, bmat, n, k, np, mode, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, mode, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,2), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer i, ierr, ipj, irj, ivj, iter, itry, j, msglvl, infol,
& jj
Double precision
& rnorm1, wnorm, safmin, temp1
save orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl,
& rnorm1, safmin, wnorm
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, pdgetv0, pdvout, pdmout,
& dlascl, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, pdlamch
external ddot, pdnorm2, pdlamch
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
first = .false.
c
c %--------------------------------%
c | safmin = safe minimum is such |
c | that 1/sfmin does not overflow |
c %--------------------------------%
c
safmin = pdlamch(comm,'safmin')
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = msaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
c
c %--------------------------------%
c | Pointer to the current step of |
c | the factorization to build |
c %--------------------------------%
c
j = k + 1
c
c %------------------------------------------%
c | Pointers used for reverse communication |
c | when using WORKD. |
c %------------------------------------------%
c
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pdgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %------------------------------%
c | Else this is the first step. |
c %------------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
c
1000 continue
c
if (msglvl .gt. 2) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: generating Arnoldi vector no.')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_saitr: B-norm of the current residual =')
end if
c
c %---------------------------------------------------------%
c | Check for exact zero. Equivalent to determing whether a |
c | j-step Arnoldi factorization is present. |
c %---------------------------------------------------------%
c
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_saitr: ****** restart at step ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pdgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. safmin) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j}. |
c %-----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
c
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %-------------------------------------------%
c | STEP 4: Finish extending the symmetric |
c | Arnoldi to length j. If MODE = 2 |
c | then B*OP = B*inv(B)*A = A and |
c | we don't need to compute B*OP. |
c | NOTE: If MODE = 2 WORKD(IVJ:IVJ+N-1) is |
c | assumed to have A*v_{j}. |
c %-------------------------------------------%
c
if (mode .eq. 2) go to 65
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy(n, resid, 1 , workd(ipj), 1)
end if
60 continue
c
c %-----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j}. |
c %-----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
65 continue
if (mode .eq. 2) then
c
c %----------------------------------%
c | Note that the B-norm of OP*v_{j} |
c | is the inv(B)-norm of A*v_{j}. |
c %----------------------------------%
c
wnorm = ddot (n, resid, 1, workd(ivj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'G') then
wnorm = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
if (mode .ne. 2 ) then
call dgemv('T', n, j, one, v, ldv, workd(ipj), 1, zero,
& workl(1), 1)
call dgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
else if (mode .eq. 2) then
call dgemv('T', n, j, one, v, ldv, workd(ivj), 1, zero,
& workl(1), 1)
call dgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
end if
c
c %--------------------------------------%
c | Orthgonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv('N', n, j, -one, v, ldv, workl(1), 1, one,
& resid, 1)
c
c %--------------------------------------%
c | Extend H to have j rows and columns. |
c %--------------------------------------%
c
h(j,2) = workl(j)
if (j .eq. 1 .or. rstart) then
h(j,1) = zero
else
h(j,1) = rnorm
end if
call arscnd (t4)
c
orth1 = .true.
iter = 0
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization ; wnorm and rnorm are')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call dgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %----------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) + |
c | v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j, but only |
c | H(j,j) is updated. |
c %----------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
c
if (j .eq. 1 .or. rstart) h(j,1) = zero
h(j,2) = h(j,2) + workl(j)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm1, 1, -1, -1 )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %--------------------------------%
c | No need for further refinement |
c %--------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %----------------------------------------------------------%
c | Make sure the last off-diagonal element is non negative |
c | If not perform a similarity transformation on H(1:j,1:j) |
c | and scale v(:,j) by -1. |
c %----------------------------------------------------------%
c
if (h(j,1) .lt. zero) then
h(j,1) = -h(j,1)
if ( j .lt. k+np) then
call dscal(n, -one, v(1,j+1), 1)
else
call dscal(n, -one, resid, 1)
end if
end if
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tsaitr = tsaitr + (t1 - t0)
ido = 99
c
if (msglvl .gt. 1) then
call pdvout (comm, logfil, k+np, h(1,2), ndigit,
& '_saitr: main diagonal of matrix H of step K+NP.')
if (k+np .gt. 1) then
call pdvout (comm, logfil, k+np-1, h(2,1), ndigit,
& '_saitr: sub diagonal of matrix H of step K+NP.')
end if
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pdsaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pzngets.f 0000644 0001750 0001750 00000013513 12277373057 014521 0000000 0000000 c\BeginDoc
c
c\Name: pzngets
c
c Message Passing Layer: BLACS
c
c\Description:
c Given the eigenvalues of the upper Hessenberg matrix H,
c computes the NP shifts AMU that are zeros of the polynomial of
c degree NP which filters out components of the unwanted eigenvectors
c corresponding to the AMU's based on some given criteria.
c
c NOTE: call this even in the case of user specified shifts in order
c to sort the eigenvalues, and error bounds of H for later use.
c
c\Usage:
c call pzngets
c ( COMM, ISHIFT, WHICH, KEV, NP, RITZ, BOUNDS )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c ISHIFT Integer. (INPUT)
c Method for selecting the implicit shifts at each iteration.
c ISHIFT = 0: user specified shifts
c ISHIFT = 1: exact shift with respect to the matrix H.
c
c WHICH Character*2. (INPUT)
c Shift selection criteria.
c 'LM' -> want the KEV eigenvalues of largest magnitude.
c 'SM' -> want the KEV eigenvalues of smallest magnitude.
c 'LR' -> want the KEV eigenvalues of largest REAL part.
c 'SR' -> want the KEV eigenvalues of smallest REAL part.
c 'LI' -> want the KEV eigenvalues of largest imaginary part.
c 'SI' -> want the KEV eigenvalues of smallest imaginary part.
c
c KEV Integer. (INPUT)
c The number of desired eigenvalues.
c
c NP Integer. (INPUT)
c The number of shifts to compute.
c
c RITZ Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c On INPUT, RITZ contains the the eigenvalues of H.
c On OUTPUT, RITZ are sorted so that the unwanted
c eigenvalues are in the first NP locations and the wanted
c portion is in the last KEV locations. When exact shifts are
c selected, the unwanted part corresponds to the shifts to
c be applied. Also, if ISHIFT .eq. 1, the unwanted eigenvalues
c are further sorted so that the ones with largest Ritz values
c are first.
c
c BOUNDS Complex*16 array of length KEV+NP. (INPUT/OUTPUT)
c Error bounds corresponding to the ordering in RITZ.
c
c
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c zsortc ARPACK sorting routine.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzvout Parallel ARPACK utility routine that prints vectors.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: ngets.F SID: 2.1
c
c\SCCS Information:
c FILE: ngets.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c 1. This routine does not keep complex conjugate pairs of
c eigenvalues together.
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzngets ( comm, ishift, which, kev, np, ritz, bounds)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
character*2 which
integer ishift, kev, np
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(kev+np), ritz(kev+np)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external pzvout, zsortc, arscnd
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcgets
c
call zsortc (which, .true., kev+np, ritz, bounds)
c
if ( ishift .eq. 1 ) then
c
c %-------------------------------------------------------%
c | Sort the unwanted Ritz values used as shifts so that |
c | the ones with largest Ritz estimates are first |
c | This will tend to minimize the effects of the |
c | forward instability of the iteration when the shifts |
c | are applied in subroutine pznapps. |
c | Be careful and use 'SM' since we want to sort BOUNDS! |
c %-------------------------------------------------------%
c
call zsortc ( 'SM', .true., np, bounds, ritz )
c
end if
c
call arscnd (t1)
tcgets = tcgets + (t1 - t0)
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, kev, ndigit, '_ngets: KEV is')
call pivout (comm, logfil, 1, np, ndigit, '_ngets: NP is')
call pzvout (comm, logfil, kev+np, ritz, ndigit,
& '_ngets: Eigenvalues of current H matrix ')
call pzvout (comm, logfil, kev+np, bounds, ndigit,
& '_ngets: Ritz estimates of the current KEV+NP Ritz values')
end if
c
return
c
c %----------------%
c | End of pzngets |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pzneupd.f 0000644 0001750 0001750 00000105006 12277373057 014513 0000000 0000000 c\BeginDoc
c
c\Name: pzneupd
c
c Message Passing Layer: BLACS
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PZNAUPD. PZNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of PZNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of PZNAUPD.
c
c\Usage:
c call pzneupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 PZNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to PZNAUPD 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, RWORK, INFO
c
c must be passed directly to ZNEUPD following the last call
c to PZNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PZNAUPD and the call to ZNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex*16 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 PZNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c PZNAUPD. They are not changed by PZNEUPD.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 PZNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 PZNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ztrsen.
c Re-enter subroutine pzneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ztrevc.
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: PZNAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine that computes the Schur form of a
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form.
c ztrsen LAPACK routine that re-orders the Schur form.
c zunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c pdlamch ScaLAPACK routine that determines machine constants.
c ztrmm Level 3 BLAS matrix times an upper triangular matrix.
c zgeru Level 2 BLAS rank one update to a matrix.
c zcopy Level 1 BLAS that copies one vector to another .
c zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 Level 1 BLAS that computes the norm of a complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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
c upper triangular matrix stored workl(ipntr(12)).
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: neupd.F SID: 2.2
c
c\SCCS Information:
c FILE: neupd.F SID: 1.9 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pzneupd
& ( comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex*16
& sigma
Double precision
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Double precision
& rwork(ncv)
Complex*16
& d(nev) , resid(n) , v(ldv,ncv) ,
& z(ldz, nev), workd(3*n), workl(lworkl),
& workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift
Complex*16
& rnorm, temp, vl(1)
Double precision
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zcopy ,zgeru,zgeqr2,zlacpy,pzmout,
& zunm2r,ztrmm,pzvout,pivout,
& zlahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2,pdlamch,dlapy2
external dznrm2,pdlamch,dlapy2
c
Complex*16
& zdotc
external zdotc
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pdlamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pzvout(comm, logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values passed in from _NAUPD.')
call pzvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pzngets(comm, ishift, which ,
& nev , np , workl(irz),
& workl(bounds))
c
if (msglvl .gt. 2) then
call pzvout(comm,logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values after calling _NGETS.')
call pzvout(comm,logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 zlahqr to compute the Schur form |
c | of the upper Hessenberg matrix returned by PZNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pzvout(comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
call pzvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pzmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
if (reord) then
c
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)
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pzvout (comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pzmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call zcopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call zcopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using zunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
c
c %------------------------------------------------%
c | Scale the returning eigenvectors so that their |
c | Euclidean norms are all one. LAPACK subroutine |
c | ztrevc returns each eigenvector normalized so |
c | that the element of largest magnitude has |
c | magnitude 1. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = dznrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = dble(one) / rtemp
call zdscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
call zcopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call pzvout(comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pzmout(comm, logfil, nconv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call zcopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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
end if
c
else
c
c %--------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PZNAUPD 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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call zscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pzvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call pzvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call pzvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call pzvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call zgeru(n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pzneupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psseigt.f 0000644 0001750 0001750 00000012733 12277373057 014510 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psseigt
c
c Message Passing Layer: BLACS
c
c\Description:
c Compute the eigenvalues of the current symmetric tridiagonal matrix
c and the corresponding error bounds given the current residual norm.
c
c\Usage:
c call psseigt
c ( COMM, RNORM, N, H, LDH, EIG, BOUNDS, WORKL, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RNORM Real scalar. (INPUT)
c RNORM contains the residual norm corresponding to the current
c symmetric tridiagonal matrix H.
c
c N Integer. (INPUT)
c Size of the symmetric tridiagonal matrix H.
c
c H Real N by 2 array. (INPUT)
c H contains the symmetric tridiagonal matrix with the
c subdiagonal in the first column starting at H(2,1) and the
c main diagonal in second column.
c
c LDH Integer. (INPUT)
c Leading dimension of H exactly as declared in the calling
c program.
c
c EIG Real array of length N. (OUTPUT)
c On output, EIG contains the N eigenvalues of H possibly
c unsorted. The BOUNDS arrays are returned in the
c same sorted order as EIG.
c
c BOUNDS Real array of length N. (OUTPUT)
c On output, BOUNDS contains the error estimates corresponding
c to the eigenvalues EIG. This is equal to RNORM times the
c last components of the eigenvectors corresponding to the
c eigenvalues in EIG.
c
c WORKL Real work array of length 3*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 sstqrb.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\Routines called:
c sstqrb ARPACK routine that computes the eigenvalues and the
c last components of the eigenvectors of a symmetric
c and tridiagonal matrix.
c arscnd ARPACK utility routine for timing.
c psvout Parallel ARPACK utility routine that prints vectors.
c scopy Level 1 BLAS that copies one vector to another.
c sscal Level 1 BLAS that scales a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: seigt.F SID: 2.2
c
c\SCCS Information:
c FILE: seigt.F SID: 1.3 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psseigt
& ( comm, rnorm, n, h, ldh, eig, bounds, workl, ierr )
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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, ldh, n
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Real
& eig(n), bounds(n), h(ldh,2), workl(3*n)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
integer i, k, msglvl
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external scopy, sstqrb, psvout, arscnd
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mseigt
c
if (msglvl .gt. 0) then
call psvout (comm, logfil, n, h(1,2), ndigit,
& '_seigt: main diagonal of matrix H')
if (n .gt. 1) then
call psvout (comm, logfil, n-1, h(2,1), ndigit,
& '_seigt: sub diagonal of matrix H')
end if
end if
c
c
call scopy (n, h(1,2), 1, eig, 1)
call scopy (n-1, h(2,1), 1, workl, 1)
call sstqrb (n, eig, workl, bounds, workl(n+1), ierr)
if (ierr .ne. 0) go to 9000
c
if (msglvl .gt. 1) then
call psvout (comm, logfil, n, bounds, ndigit,
& '_seigt: last row of the eigenvector matrix for H')
end if
c
c %-----------------------------------------------%
c | Finally determine the error bounds associated |
c | with the n Ritz values of H. |
c %-----------------------------------------------%
c
do 30 k = 1, n
bounds(k) = rnorm*abs(bounds(k))
30 continue
c
call arscnd (t1)
tseigt = tseigt + (t1 - t0)
c
9000 continue
return
c
c %-----------------%
c | End of psseigt |
c %-----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pzneigh.f 0000644 0001750 0001750 00000020714 12277373057 014474 0000000 0000000 c\BeginDoc
c
c\Name: pzneigh
c
c Message Passing Layer: BLACS
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 pzneigh
c ( COMM, RNORM, N, H, LDH, RITZ, BOUNDS, Q, LDQ, WORKL, RWORK, IERR )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RNORM Double precision 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*16 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*16 array of length N. (OUTPUT)
c On output, RITZ(1:N) contains the eigenvalues of H.
c
c BOUNDS Complex*16 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*16 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*16 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 Double precision 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 zlahqr or ztrevc.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c pdvout Parallel ARPACK utility routine that prints vectors.
c zlacpy LAPACK matrix copy routine.
c zlahqr LAPACK routine to compute the Schur form of an
c upper Hessenberg matrix.
c zlaset LAPACK matrix initialization routine.
c ztrevc LAPACK routine to compute the eigenvectors of a matrix
c in upper triangular form
c zcopy Level 1 BLAS that copies one vector to another.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c dznrm2 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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Complex Code FILE: neigh.F SID: 2.1
c
c\SCCS Information:
c FILE: neigh.F SID: 1.2 DATE OF SID: 4/19/96
c
c\Remarks
c None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pzneigh (comm, rnorm, n, h, ldh, ritz, bounds,
& q, ldq, workl, rwork, ierr)
c
c %--------------------%
c | BLACS Communicator |
c %--------------------%
c
integer comm
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
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
Complex*16
& bounds(n), h(ldh,n), q(ldq,n), ritz(n),
& workl(n*(n+3))
Double precision
& rwork(n)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0)
c
c %------------------------%
c | Local Scalars & Arrays |
c %------------------------%
c
logical select(1)
integer j, msglvl
Complex*16
& vl(1)
Double precision
& temp
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zlacpy, zlahqr, zdscal, ztrevc, zcopy,
& pzmout, pzvout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& dznrm2
external dznrm2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mceigh
c
if (msglvl .gt. 2) then
call pzmout (comm, 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 | zlahqr returns the full Schur form of H |
c | in WORKL(1:N**2), and the Schur vectors in q. |
c %----------------------------------------------------------%
c
call zlacpy ('All', n, n, h, ldh, workl, n)
call zlaset ('All', n, n, zero, one, q, ldq)
call zlahqr (.true., .true., n, 1, n, workl, ldh, ritz,
& 1, n, q, ldq, ierr)
if (ierr .ne. 0) go to 9000
c
call zcopy (n, q(n-1,1), ldq, bounds, 1)
if (msglvl .gt. 1) then
call pzvout (comm, 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 ztrevc ('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 | ztrevc 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 = dznrm2( n, q(1,j), 1 )
call zdscal ( n, rone / temp, q(1,j), 1 )
10 continue
c
if (msglvl .gt. 1) then
call zcopy(n, q(n,1), ldq, workl, 1)
call pzvout (comm, 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 zcopy(n, q(n,1), n, bounds, 1)
call zdscal(n, rnorm, bounds, 1)
c
if (msglvl .gt. 2) then
call pzvout (comm, logfil, n, ritz, ndigit,
& '_neigh: The eigenvalues of H')
call pzvout (comm, logfil, n, bounds, ndigit,
& '_neigh: Ritz estimates for the eigenvalues of H')
end if
c
call arscnd(t1)
tceigh = tceigh + (t1 - t0)
c
9000 continue
return
c
c %----------------%
c | End of pzneigh |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pznaitr.f 0000644 0001750 0001750 00000076654 12277373057 014535 0000000 0000000 c\BeginDoc
c
c\Name: pznaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pznaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pznaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recomputed in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pznaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Complex*16 array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Complex*16 N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Complex*16 (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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. (REVERSE COMMUNICATION)
c Distributed array to be used in the basic Arnoldi iteration
c for reverse communication. The calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Complex*16 work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx Complex*16
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pzgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pzmout Parallel ARPACK utility routine that prints matrices
c pzvout Parallel ARPACK utility routine that prints vectors.
c zlanhs LAPACK routine that computes various norms of a matrix.
c zlascl LAPACK routine for careful scaling of a matrix.
c dlabad LAPACK routine for defining the underflow and overflow
c limits
c pdlamch ScaLAPACK routine that determines machine constants.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c zgemv Level 2 BLAS routine for matrix vector multiplication.
c zaxpy Level 1 BLAS that computes a vector triad.
c zcopy Level 1 BLAS that copies one vector to another .
c zdotc Level 1 BLAS that computes the scalar product of
c two vectors.
c zscal Level 1 BLAS that scales a vector.
c zdscal Level 1 BLAS that scales a complex vector by a real number.
c pdznorm2 Parallel version of Level 1 BLAS that computes the
c norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: naitr.F SID: 2.1
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pznaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pznaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external zgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Complex*16
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Complex*16
& one, zero
Double precision
& rone, rzero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
& rone = 1.0, rzero = 0.0)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& rtemp(2)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& ovfl, smlnum, tst1, ulp, unfl, betaj,
& temp1, rnorm1, wnorm
Complex*16
& cnorm
c
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external zaxpy, zcopy, zscal, zgemv, pzgetv0, dlabad,
& zdscal, pzvout, pzmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
Double precision
& pdlamch, pdznorm2, zlanhs, dlapy2
external zdotc, pdznorm2, zlanhs, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, max, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine zlahqr |
c %-----------------------------------------%
c
unfl = pdlamch(comm, 'safe minimum' )
ovfl = dble(one / unfl)
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mcaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pzgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pzvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determine whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. rzero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = rzero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pzgetv0 (comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call zcopy (n, resid, 1, v(1,j), 1)
if ( rnorm .ge. unfl) then
temp1 = rone / rnorm
call zdscal (n, temp1, v(1,j), 1)
call zdscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine zlascl |
c %-----------------------------------------%
c
call zlascl ('General', i, i, rnorm, rone,
& n, 1, v(1,j), n, infol)
call zlascl ('General', i, i, rnorm, rone,
& n, 1, workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call zcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call zcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = pdznorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
call zgsum2d( comm, 'All', ' ', j, 1, h(1,j), j, -1, -1 )
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = dcmplx(betaj, rzero)
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = pdznorm2(comm, n, resid, 1)
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if ( rnorm .gt. 0.717*wnorm ) go to 100
c
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
rtemp(1) = wnorm
rtemp(2) = rnorm
call pdvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: re-orthogonalization; wnorm and rnorm are')
call pzvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call zgemv ('C', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call zgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call zgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call zaxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call zcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call zcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = pdznorm2(comm, n, resid, 1)
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0 ) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
rtemp(1) = rnorm
rtemp(2) = rnorm1
call pdvout (comm, logfil, 2, rtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if ( rnorm1 .gt. 0.717*rnorm ) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = rzero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tcaitr = tcaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %--------------------------------------------%
c
tst1 = dlapy2(dble(h(i,i)),dimag(h(i,i)))
& + dlapy2(dble(h(i+1,i+1)), dimag(h(i+1,i+1)))
if( tst1.eq.dble(zero) )
& tst1 = zlanhs( '1', k+np, h, ldh, workd(n+1) )
if( dlapy2(dble(h(i+1,i)),dimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pzmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pznaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/psnaitr.f 0000644 0001750 0001750 00000075374 12277373057 014524 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: psnaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in psnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call psnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See psnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Real array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Real scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Real N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Real (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Real work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c psgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c psmout Parallel ARPACK utility routine that prints matrices
c psvout Parallel ARPACK utility routine that prints vectors.
c slabad LAPACK routine that computes machine constants.
c pslamch ScaLAPACK routine that determines machine constants.
c slascl LAPACK routine for careful scaling of a matrix.
c slanhs LAPACK routine that computes various norms of a matrix.
c sgemv Level 2 BLAS routine for matrix vector multiplication.
c saxpy Level 1 BLAS that computes a vector triad.
c sscal Level 1 BLAS that scales a vector.
c scopy Level 1 BLAS that copies one vector to another .
c sdot Level 1 BLAS that computes the scalar product of two vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naitr.F SID: 2.2
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in psnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine psnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external sgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Real
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Real
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Real
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Real
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external saxpy, scopy, sscal, sgemv, psgetv0, slabad,
& psvout, psmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& sdot, psnorm2, slanhs, pslamch
external sdot, psnorm2, slanhs, pslamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine slahqr |
c %-----------------------------------------%
c
unfl = pslamch(comm, 'safe minimum' )
ovfl = one / unfl
call slabad( unfl, ovfl )
ulp = pslamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | psgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call psvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call psgetv0 ( comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call scopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call sscal (n, temp1, v(1,j), 1)
call sscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call slascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call slascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call scopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call scopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
wnorm = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
call sgsum2d( comm, 'All', ' ', j, 1, h(1,j), j, -1, -1 )
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = psnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call psvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call sgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call sgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call sgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call saxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call scopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call scopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = sdot (n, resid, 1, workd(ipj), 1)
call sgsum2d( comm, 'All', ' ', 1, 1, rnorm1, 1, -1, -1 )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = psnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call psvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine slahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = slanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call psmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of psnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pslamch.f 0000644 0001750 0001750 00000005076 12277373057 014463 0000000 0000000 REAL FUNCTION PSLAMCH( ICTXT, CMACH )
*
* -- ScaLAPACK auxilliary routine (version 1.0) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* February 28, 1995
*
* .. Scalar Arguments ..
CHARACTER CMACH
INTEGER ICTXT
* ..
*
* Purpose
* =======
*
* PSLAMCH determines single precision machine parameters.
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle in which the computation takes
* place.
*
* CMACH (global input) CHARACTER*1
* Specifies the value to be returned by PSLAMCH:
* = 'E' or 'e', PSLAMCH := eps
* = 'S' or 's , PSLAMCH := sfmin
* = 'B' or 'b', PSLAMCH := base
* = 'P' or 'p', PSLAMCH := eps*base
* = 'N' or 'n', PSLAMCH := t
* = 'R' or 'r', PSLAMCH := rnd
* = 'M' or 'm', PSLAMCH := emin
* = 'U' or 'u', PSLAMCH := rmin
* = 'L' or 'l', PSLAMCH := emax
* = 'O' or 'o', PSLAMCH := rmax
*
* where
*
* eps = relative machine precision
* sfmin = safe minimum, such that 1/sfmin does not overflow
* base = base of the machine
* prec = eps*base
* t = number of (base) digits in the mantissa
* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
* emin = minimum exponent before (gradual) underflow
* rmin = underflow threshold - base**(emin-1)
* emax = largest exponent before overflow
* rmax = overflow threshold - (base**emax)*(1-eps)
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER IDUMM
REAL TEMP
* ..
* .. External Subroutines ..
EXTERNAL SGAMN2D, SGAMX2D
* ..
* .. External Functions ..
LOGICAL LSAME
REAL SLAMCH
EXTERNAL LSAME, SLAMCH
* ..
* .. Executable Statements ..
*
TEMP = SLAMCH( CMACH )
*
IF( LSAME( CMACH, 'E' ).OR.LSAME( CMACH, 'S' ).OR.
$ LSAME( CMACH, 'M' ).OR.LSAME( CMACH, 'U' ) ) THEN
CALL SGAMX2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
$ IDUMM, 1, -1, IDUMM )
ELSE IF( LSAME( CMACH, 'L' ).OR.LSAME( CMACH, 'O' ) ) THEN
CALL SGAMN2D( ICTXT, 'All', ' ', 1, 1, TEMP, 1, IDUMM,
$ IDUMM, 1, -1, IDUMM )
END IF
*
PSLAMCH = TEMP
*
* End of PSLAMCH
*
END
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pcneupd.f 0000644 0001750 0001750 00000104654 12277373057 014474 0000000 0000000 c\BeginDoc
c
c\Name: pcneupd
c
c Message Passing Layer: BLACS
c
c\Description:
c This subroutine returns the converged approximations to eigenvalues
c of A*z = lambda*B*z and (optionally):
c
c (1) The corresponding approximate eigenvectors;
c
c (2) An orthonormal basis for the associated approximate
c invariant subspace;
c
c (3) Both.
c
c There is negligible additional cost to obtain eigenvectors. An orthonormal
c basis is always computed. There is an additional storage cost of n*nev
c if both are requested (in this case a separate array Z must be supplied).
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 PCNAUPD. PCNAUPD 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 The definition of OP as well as other terms and the relation of computed
c Ritz values and vectors of OP with respect to the given problem
c A*z = lambda*B*z may be found in the header of PCNAUPD. For a brief
c description, see definitions of IPARAM(7), MODE and WHICH in the
c documentation of PCNAUPD.
c
c\Usage:
c call pcneupd
c ( COMM, RVEC, HOWMNY, SELECT, D, Z, LDZ, SIGMA, WORKEV, BMAT,
c N, WHICH, NEV, TOL, RESID, NCV, V, LDV, IPARAM, IPNTR, WORKD,
c WORKL, LWORKL, RWORK, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c RVEC LOGICAL (INPUT)
c Specifies whether a basis for the invariant subspace corresponding
c to the converged Ritz value approximations for the eigenproblem
c A*z = lambda*B*z is computed.
c
c RVEC = .FALSE. Compute Ritz values only.
c
c RVEC = .TRUE. Compute Ritz vectors or Schur vectors.
c See Remarks below.
c
c HOWMNY Character*1 (INPUT)
c Specifies the form of the basis for the invariant subspace
c corresponding to the converged Ritz values that is to be computed.
c
c = 'A': Compute NEV Ritz vectors;
c = 'P': Compute NEV Schur vectors;
c = 'S': compute some of the Ritz vectors, specified
c by the logical array SELECT.
c
c SELECT Logical array of dimension NCV. (INPUT)
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' 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 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 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
c A*z = lambda*B*z.
c
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 PCNAUPD. 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 .ge. max( 1, N ) is required.
c In any case, LDZ .ge. 1 is required.
c
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 2*NCV. (WORKSPACE)
c
c **** The remaining arguments MUST be the same as for the ****
c **** call to PCNAUPD 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, RWORK, INFO
c
c must be passed directly to CNEUPD following the last call
c to PCNAUPD. These arguments MUST NOT BE MODIFIED between
c the the last call to PCNAUPD and the call to CNEUPD.
c
c Three of these parameters (V, WORKL and INFO) are also output parameters:
c
c V Complex 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 PCNAUPD .
c
c Upon OUTPUT: If RVEC = .TRUE. the first NCONV=IPARAM(5) columns
c contain approximate Schur vectors that span the
c desired invariant subspace.
c
c NOTE: If the array Z has been set equal to first NEV+1 columns
c of the array V and RVEC=.TRUE. and HOWMNY= 'A', then the
c Arnoldi basis held by V has been overwritten by the desired
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(1:ncv*ncv+2*ncv) contains information obtained in
c PCNAUPD. They are not changed by PCNEUPD.
c WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
c untransformed Ritz values, the untransformed error estimates of
c the Ritz values, the upper 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 PCNEUPD.
c -------------------------------------------------------------
c IPNTR(9): pointer to the NCV RITZ values of the
c original system.
c IPNTR(10): Not used
c IPNTR(11): pointer to the NCV corresponding error estimates.
c IPNTR(12): pointer to the NCV by NCV upper 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 PCNEUPD if RVEC = .TRUE. See Remark 2 below.
c -------------------------------------------------------------
c
c INFO Integer. (OUTPUT)
c Error flag on output.
c = 0: Normal exit.
c
c = 1: The Schur form computed by LAPACK routine csheqr
c could not be reordered by LAPACK routine ctrsen.
c Re-enter subroutine pcneupd with IPARAM(5)=NCV and
c increase the size of the array D 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
c the same space. Please notify the authors if this error
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 = -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 LAPACK eigenvalue calculation.
c This should never happened.
c = -9: Error return from calculation of eigenvectors.
c Informational error from LAPACK routine ctrevc.
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: PCNAUPD 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
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c 3. B. Nour-Omid, B. N. Parlett, T. Ericsson and P. S. Jensen,
c "How to Implement the Spectral Transformation", Math Comp.,
c Vol. 48, No. 178, April, 1987 pp. 664-673.
c
c\Routines called:
c pivout Parallel ARPACK utility routine that prints integers.
c pcmout Parallel ARPACK utility routine that prints matrices
c pcvout Parallel ARPACK utility routine that prints vectors.
c cgeqr2 LAPACK routine that computes the QR factorization of
c a matrix.
c clacpy LAPACK matrix copy routine.
c clahqr LAPACK routine that computes the Schur form of a
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 ctrsen LAPACK routine that re-orders the Schur form.
c cunm2r LAPACK routine that applies an orthogonal matrix in
c factored form.
c pslamch ScaLAPACK routine that determines machine constants.
c ctrmm Level 3 BLAS matrix times an upper triangular matrix.
c cgeru Level 2 BLAS rank one update to a matrix.
c ccopy Level 1 BLAS that copies one vector to another .
c cscal Level 1 BLAS that scales a vector.
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 complex vector.
c
c\Remarks
c
c 1. Currently only HOWMNY = 'A' and 'P' are implemented.
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
c upper triangular matrix stored workl(ipntr(12)).
c
c\Authors
c Danny Sorensen Phuong Vu
c Richard Lehoucq CRPC / Rice University
c Chao Yang Houston, Texas
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Serial Code FILE: neupd.F SID: 2.2
c
c\SCCS Information:
c FILE: neupd.F SID: 1.9 DATE OF SID: 10/25/03
c
c\EndLib
c
c-----------------------------------------------------------------------
subroutine pcneupd
& ( comm , 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 | BLACS Communicator |
c %--------------------%
c
integer comm
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
character bmat, howmny, which*2
logical rvec
integer info, ldz, ldv, lworkl, n, ncv, nev
Complex
& sigma
Real
& tol
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer iparam(11), ipntr(14)
logical select(ncv)
Real
& rwork(ncv)
Complex
& d(nev) , resid(n) , v(ldv,ncv) ,
& z(ldz, nev), workd(3*n), workl(lworkl),
& workev(2*ncv)
c
c %------------%
c | Parameters |
c %------------%
c
Complex
& one, zero
parameter (one = (1.0, 0.0), zero = (0.0, 0.0))
c
c %---------------%
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 , outncv, iq , np , numcnv, jj ,
& ishift
Complex
& rnorm, temp, vl(1)
Real
& conds, sep, rtemp, eps23
logical reord
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external ccopy ,cgeru,cgeqr2,clacpy,pcmout,
& cunm2r,ctrmm,pcvout,pivout,
& clahqr
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Real
& scnrm2,pslamch,slapy2
external scnrm2,pslamch,slapy2
c
Complex
& cdotc
external cdotc
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
c %------------------------%
c | Set default parameters |
c %------------------------%
c
msglvl = mceupd
mode = iparam(7)
nconv = iparam(5)
info = 0
c
c
c %---------------------------------%
c | Get machine dependent constant. |
c %---------------------------------%
c
eps23 = pslamch(comm, 'Epsilon-Machine')
eps23 = eps23**(2.0 / 3.0)
c
c %-------------------------------%
c | Quick return |
c | Check for incompatible input |
c %-------------------------------%
c
ierr = 0
c
if (nconv .le. 0) then
ierr = -14
else if (n .le. 0) then
ierr = -1
else if (nev .le. 0) then
ierr = -2
else if (ncv .le. nev+1 .or. ncv .gt. n) then
ierr = -3
else if (which .ne. 'LM' .and.
& which .ne. 'SM' .and.
& which .ne. 'LR' .and.
& which .ne. 'SR' .and.
& which .ne. 'LI' .and.
& which .ne. 'SI') then
ierr = -5
else if (bmat .ne. 'I' .and. bmat .ne. 'G') then
ierr = -6
else if (lworkl .lt. 3*ncv**2 + 4*ncv) then
ierr = -7
else if ( (howmny .ne. 'A' .and.
& howmny .ne. 'P' .and.
& howmny .ne. 'S') .and. rvec ) then
ierr = -13
else if (howmny .eq. 'S' ) then
ierr = -12
end if
c
if (mode .eq. 1 .or. mode .eq. 2) then
type = 'REGULR'
else if (mode .eq. 3 ) then
type = 'SHIFTI'
else
ierr = -10
end if
if (mode .eq. 1 .and. bmat .eq. 'G') ierr = -11
c
c %------------%
c | Error Exit |
c %------------%
c
if (ierr .ne. 0) then
info = ierr
go to 9000
end if
c
c %--------------------------------------------------------%
c | Pointer into WORKL for address of H, RITZ, WORKEV, Q |
c | etc... and the remaining workspace. |
c | Also update pointer to be used on output. |
c | Memory is laid out as follows: |
c | workl(1:ncv*ncv) := generated Hessenberg matrix |
c | workl(ncv*ncv+1:ncv*ncv+ncv) := ritz values |
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 | 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 |
c | error bounds of |
c | the Ritz values |
c | workl(ncv*ncv+4*ncv+1:2*ncv*ncv+4*ncv) := Holds the upper |
c | triangular matrix |
c | for H. |
c | workl(2*ncv*ncv+4*ncv+1: 3*ncv*ncv+4*ncv) := Holds the |
c | associated matrix |
c | representation of |
c | the invariant |
c | subspace for H. |
c | GRAND total of NCV * ( 3 * NCV + 4 ) locations. |
c %-----------------------------------------------------------%
c
ih = ipntr(5)
ritz = ipntr(6)
iq = ipntr(7)
bounds = ipntr(8)
ldh = ncv
ldq = ncv
iheig = bounds + ldh
ihbds = iheig + ldh
iuptri = ihbds + ldh
invsub = iuptri + ldh*ncv
ipntr(9) = iheig
ipntr(11) = ihbds
ipntr(12) = iuptri
ipntr(13) = invsub
wr = 1
iwev = wr + ncv
c
c %-----------------------------------------%
c | irz points to the Ritz values computed |
c | by _neigh before exiting _naup2. |
c | ibd points to the Ritz estimates |
c | computed by _neigh before exiting |
c | _naup2. |
c %-----------------------------------------%
c
irz = ipntr(14) + ncv*ncv
ibd = irz + ncv
c
c %------------------------------------%
c | RNORM is B-norm of the RESID(1:N). |
c %------------------------------------%
c
rnorm = workl(ih+2)
workl(ih+2) = zero
c
if (msglvl .gt. 2) then
call pcvout(comm, logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values passed in from _NAUPD.')
call pcvout(comm, logfil, ncv, workl(ibd), ndigit,
& '_neupd: Ritz estimates passed in from _NAUPD.')
end if
c
if (rvec) then
c
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 pcngets(comm, ishift, which ,
& nev , np , workl(irz),
& workl(bounds))
c
if (msglvl .gt. 2) then
call pcvout(comm,logfil, ncv, workl(irz), ndigit,
& '_neupd: Ritz values after calling _NGETS.')
call pcvout(comm,logfil, ncv, workl(bounds), ndigit,
& '_neupd: Ritz value indices after calling _NGETS.')
end if
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
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 pivout(comm, logfil, 1, numcnv, ndigit,
& '_neupd: Number of specified eigenvalues')
call pivout(comm, 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 clahqr to compute the Schur form |
c | of the upper Hessenberg matrix returned by PCNAUPD. |
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)
c
if (ierr .ne. 0) then
info = -8
go to 9000
end if
c
if (msglvl .gt. 1) then
call pcvout(comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H')
call pcvout(comm, logfil, ncv, workl(ihbds), ndigit,
& '_neupd: Last row of the Schur vector matrix')
if (msglvl .gt. 3) then
call pcmout(comm, logfil, ncv, ncv,
& workl(iuptri), ldh, ndigit,
& '_neupd: The upper triangular matrix ')
end if
end if
if (reord) then
c
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)
c
if (ierr .eq. 1) then
info = 1
go to 9000
end if
c
if (msglvl .gt. 2) then
call pcvout (comm, logfil, ncv, workl(iheig), ndigit,
& '_neupd: Eigenvalues of H--reordered')
if (msglvl .gt. 3) then
call pcmout (comm, logfil, ncv, ncv,
& workl(iuptri), ldq, ndigit,
& '_neupd: Triangular matrix after re-ordering')
end if
end if
end if
c
c %---------------------------------------------%
c | Copy the last row of the Schur basis matrix |
c | to workl(ihbds). This vector will be used |
c | to compute the Ritz estimates of converged |
c | Ritz values. |
c %---------------------------------------------%
c
call ccopy(ncv, workl(invsub+ncv-1), ldq, workl(ihbds), 1)
c
c %--------------------------------------------%
c | Place the computed eigenvalues of H into D |
c | if a spectral transformation was not used. |
c %--------------------------------------------%
c
if (type .eq. 'REGULR') then
call ccopy(nconv, workl(iheig), 1, d, 1)
end if
c
c %----------------------------------------------------------%
c | Compute the QR factorization of the matrix representing |
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)
c
c %--------------------------------------------------------%
c | * Postmultiply V by Q using cunm2r. |
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 |
c | of the approximate invariant subspace associated with |
c | the Ritz values in workl(iheig). The first NCONV |
c | columns of V are now approximate Schur vectors |
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)
c
do 20 j=1, nconv
c
c %---------------------------------------------------%
c | Perform both a column and row scaling if the |
c | diagonal element of workl(invsub,ldq) is negative |
c | I'm lazy and don't take advantage of the upper |
c | triangular form of workl(iuptri,ldq). |
c | Note that since Q is orthogonal, R is a diagonal |
c | matrix consisting of plus or minus ones. |
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)
end if
c
20 continue
c
if (howmny .eq. 'A') then
c
c %--------------------------------------------%
c | Compute the NCONV wanted eigenvectors of T |
c | located in workl(iuptri,ldq). |
c %--------------------------------------------%
c
do 30 j=1, ncv
if (j .le. nconv) then
select(j) = .true.
else
select(j) = .false.
end if
30 continue
c
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
go to 9000
end if
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. |
c %------------------------------------------------%
c
do 40 j=1, nconv
rtemp = scnrm2(ncv, workl(invsub+(j-1)*ldq), 1)
rtemp = real(one) / rtemp
call csscal ( ncv, rtemp,
& workl(invsub+(j-1)*ldq), 1 )
c
c %------------------------------------------%
c | Ritz estimates can be obtained by taking |
c | the inner product of the last row of the |
c | Schur basis of H with eigenvectors of T. |
c | Note that the eigenvector matrix of T is |
c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
if (msglvl .gt. 2) then
call ccopy(nconv, workl(invsub+ncv-1), ldq,
& workl(ihbds), 1)
call pcvout(comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Last row of the eigenvector matrix for T')
if (msglvl .gt. 3) then
call pcmout(comm, logfil, nconv, ncv,
& workl(invsub), ldq, ndigit,
& '_neupd: The eigenvector matrix for T')
end if
end if
c
c %---------------------------------------%
c | Copy Ritz estimates into workl(ihbds) |
c %---------------------------------------%
c
call ccopy(nconv, workev, 1, workl(ihbds), 1)
c
c %----------------------------------------------%
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
end if
c
else
c
c %--------------------------------------------------%
c | An approximate invariant subspace is not needed. |
c | Place the Ritz values computed PCNAUPD 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)
c
end if
c
c %------------------------------------------------%
c | Transform the Ritz values and possibly vectors |
c | and corresponding error bounds of OP to those |
c | of A*x = lambda*B*x. |
c %------------------------------------------------%
c
if (type .eq. 'REGULR') then
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
else
c
c %---------------------------------------%
c | A spectral transformation was used. |
c | * Determine the Ritz estimates of the |
c | Ritz values in the original system. |
c %---------------------------------------%
c
if (rvec)
& call cscal(ncv, rnorm, workl(ihbds), 1)
c
do 50 k=1, ncv
temp = workl(iheig+k-1)
workl(ihbds+k-1) = workl(ihbds+k-1) / temp / temp
50 continue
c
end if
c
c %-----------------------------------------------------------%
c | * Transform the Ritz values back to the original system. |
c | For TYPE = 'SHIFTI' the transformation is |
c | lambda = 1/theta + sigma |
c | NOTES: |
c | *The Ritz vectors are not affected by the transformation. |
c %-----------------------------------------------------------%
c
if (type .eq. 'SHIFTI') then
do 60 k=1, nconv
d(k) = one / workl(iheig+k-1) + sigma
60 continue
end if
c
if (type .ne. 'REGULR' .and. msglvl .gt. 1) then
call pcvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Untransformed Ritz values.')
call pcvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Ritz estimates of the untransformed Ritz values.')
else if ( msglvl .gt. 1) then
call pcvout (comm, logfil, nconv, d, ndigit,
& '_neupd: Converged Ritz values.')
call pcvout (comm, logfil, nconv, workl(ihbds), ndigit,
& '_neupd: Associated Ritz estimates.')
end if
c
c %-------------------------------------------------%
c | Eigenvector Purification step. Formally perform |
c | one of inverse subspace iteration. Only used |
c | for MODE = 3. See reference 3. |
c %-------------------------------------------------%
c
if (rvec .and. howmny .eq. 'A' .and. type .eq. 'SHIFTI') then
c
c %------------------------------------------------%
c | Purify the computed Ritz vectors by adding a |
c | little bit of the residual vector: |
c | T |
c | resid(:)*( e s ) / theta |
c | NCV |
c | where H s = s theta. |
c %------------------------------------------------%
c
do 100 j=1, nconv
if (workl(iheig+j-1) .ne. zero) then
workev(j) = workl(invsub+(j-1)*ldq+ncv-1)
& / workl(iheig+j-1)
endif
100 continue
c %---------------------------------------%
c | Perform a rank one update to Z and |
c | purify all the Ritz vectors together. |
c %---------------------------------------%
c
call cgeru(n, nconv, one, resid, 1, workev, 1, z, ldz)
c
end if
c
9000 continue
c
return
c
c %----------------%
c | End of pcneupd |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdnaitr.f 0000644 0001750 0001750 00000075614 12277373057 014502 0000000 0000000 c-----------------------------------------------------------------------
c\BeginDoc
c
c\Name: pdnaitr
c
c Message Passing Layer: BLACS
c
c\Description:
c Reverse communication interface for applying NP additional steps to
c a K step nonsymmetric Arnoldi factorization.
c
c Input: OP*V_{k} - V_{k}*H = r_{k}*e_{k}^T
c
c with (V_{k}^T)*B*V_{k} = I, (V_{k}^T)*B*r_{k} = 0.
c
c Output: OP*V_{k+p} - V_{k+p}*H = r_{k+p}*e_{k+p}^T
c
c with (V_{k+p}^T)*B*V_{k+p} = I, (V_{k+p}^T)*B*r_{k+p} = 0.
c
c where OP and B are as in pdnaupd. The B-norm of r_{k+p} is also
c computed and returned.
c
c\Usage:
c call pdnaitr
c ( COMM, IDO, BMAT, N, K, NP, NB, RESID, RNORM, V, LDV, H, LDH,
c IPNTR, WORKD, WORKL, INFO )
c
c\Arguments
c COMM BLACS Communicator for the processor grid. (INPUT)
c
c IDO Integer. (INPUT/OUTPUT)
c Reverse communication flag.
c -------------------------------------------------------------
c IDO = 0: first call to the reverse communication interface
c IDO = -1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c This is for the restart phase to force the new
c starting vector into the range of OP.
c IDO = 1: compute Y = OP * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y,
c IPNTR(3) is the pointer into WORK for B * X.
c IDO = 2: compute Y = B * X where
c IPNTR(1) is the pointer into WORK for X,
c IPNTR(2) is the pointer into WORK for Y.
c IDO = 99: done
c -------------------------------------------------------------
c When the routine is used in the "shift-and-invert" mode, the
c vector B * Q is already available and do not need to be
c recompute in forming OP * Q.
c
c BMAT Character*1. (INPUT)
c BMAT specifies the type of the matrix B that defines the
c semi-inner product for the operator OP. See pdnaupd.
c B = 'I' -> standard eigenvalue problem A*x = lambda*x
c B = 'G' -> generalized eigenvalue problem A*x = lambda*M**x
c
c N Integer. (INPUT)
c Dimension of the eigenproblem.
c
c K Integer. (INPUT)
c Current size of V and H.
c
c NP Integer. (INPUT)
c Number of additional Arnoldi steps to take.
c
c NB Integer. (INPUT)
c Blocksize to be used in the recurrence.
c Only work for NB = 1 right now. The goal is to have a
c program that implement both the block and non-block method.
c
c RESID Double precision array of length N. (INPUT/OUTPUT)
c On INPUT: RESID contains the residual vector r_{k}.
c On OUTPUT: RESID contains the residual vector r_{k+p}.
c
c RNORM Double precision scalar. (INPUT/OUTPUT)
c B-norm of the starting residual on input.
c B-norm of the updated residual r_{k+p} on output.
c
c V Double precision N by K+NP array. (INPUT/OUTPUT)
c On INPUT: V contains the Arnoldi vectors in the first K
c columns.
c On OUTPUT: V contains the new NP Arnoldi vectors in the next
c NP columns. The first K columns are unchanged.
c
c LDV Integer. (INPUT)
c Leading dimension of V exactly as declared in the calling
c program.
c
c H Double precision (K+NP) by (K+NP) array. (INPUT/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 IPNTR Integer array of length 3. (OUTPUT)
c Pointer to mark the starting locations in the WORK for
c vectors used by the Arnoldi iteration.
c -------------------------------------------------------------
c IPNTR(1): pointer to the current operand vector X.
c IPNTR(2): pointer to the current result vector Y.
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 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 calling program should not
c use WORKD as temporary workspace during the iteration !!!!!!
c On input, WORKD(1:N) = B*RESID and is used to save some
c computation at the first step.
c
c WORKL Double precision work space used for Gram Schmidt orthogonalization
c
c INFO Integer. (OUTPUT)
c = 0: Normal exit.
c > 0: Size of the spanning invariant subspace of OP found.
c
c\EndDoc
c
c-----------------------------------------------------------------------
c
c\BeginLib
c
c\Local variables:
c xxxxxx real
c
c\References:
c 1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
c a k-Step Arnoldi Method", SIAM J. Matr. Anal. Apps., 13 (1992),
c pp 357-385.
c 2. R.B. Lehoucq, "Analysis and Implementation of an Implicitly
c Restarted Arnoldi Iteration", Rice University Technical Report
c TR95-13, Department of Computational and Applied Mathematics.
c
c\Routines called:
c pdgetv0 Parallel ARPACK routine to generate the initial vector.
c pivout Parallel ARPACK utility routine that prints integers.
c arscnd ARPACK utility routine for timing.
c pdmout Parallel ARPACK utility routine that prints matrices
c pdvout Parallel ARPACK utility routine that prints vectors.
c dlabad LAPACK routine that computes machine constants.
c pdlamch ScaLAPACK routine that determines machine constants.
c dlascl LAPACK routine for careful scaling of a matrix.
c dlanhs LAPACK routine that computes various norms of a matrix.
c dgemv Level 2 BLAS routine for matrix vector multiplication.
c daxpy Level 1 BLAS that computes a vector triad.
c dscal Level 1 BLAS that scales a vector.
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 pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
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\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: naitr.F SID: 2.2
c
c\SCCS Information:
c FILE: naitr.F SID: 1.3 DATE OF SID: 3/19/97
c
c\Remarks
c The algorithm implemented is:
c
c restart = .false.
c Given V_{k} = [v_{1}, ..., v_{k}], r_{k};
c r_{k} contains the initial residual vector even for k = 0;
c Also assume that rnorm = || B*r_{k} || and B*r_{k} are already
c computed by the calling program.
c
c betaj = rnorm ; p_{k+1} = B*r_{k} ;
c For j = k+1, ..., k+np Do
c 1) if ( betaj < tol ) stop or restart depending on j.
c ( At present tol is zero )
c if ( restart ) generate a new starting vector.
c 2) v_{j} = r(j-1)/betaj; V_{j} = [V_{j-1}, v_{j}];
c p_{j} = p_{j}/betaj
c 3) r_{j} = OP*v_{j} where OP is defined as in pdnaupd
c For shift-invert mode p_{j} = B*v_{j} is already available.
c wnorm = || OP*v_{j} ||
c 4) Compute the j-th step residual vector.
c w_{j} = V_{j}^T * B * OP * v_{j}
c r_{j} = OP*v_{j} - V_{j} * w_{j}
c H(:,j) = w_{j};
c H(j,j-1) = rnorm
c rnorm = || r_(j) ||
c If (rnorm > 0.717*wnorm) accept step and go back to 1)
c 5) Re-orthogonalization step:
c s = V_{j}'*B*r_{j}
c r_{j} = r_{j} - V_{j}*s; rnorm1 = || r_{j} ||
c alphaj = alphaj + s_{j};
c 6) Iterative refinement step:
c If (rnorm1 > 0.717*rnorm) then
c rnorm = rnorm1
c accept step and go back to 1)
c Else
c rnorm = rnorm1
c If this is the first time in step 6), go to 5)
c Else r_{j} lies in the span of V_{j} numerically.
c Set r_{j} = 0 and rnorm = 0; go to 1)
c EndIf
c End Do
c
c\EndLib
c
c-----------------------------------------------------------------------
c
subroutine pdnaitr
& (comm, ido, bmat, n, k, np, nb, resid, rnorm, v, ldv, h, ldh,
& ipntr, workd, workl, info)
c
c
c %------------------------------%
c | BLACS Variables and Routines |
c %------------------------------%
c
integer comm
external dgsum2d
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
character bmat*1
integer ido, info, k, ldh, ldv, n, nb, np
Double precision
& rnorm
c
c %-----------------%
c | Array Arguments |
c %-----------------%
c
integer ipntr(3)
Double precision
& h(ldh,k+np), resid(n), v(ldv,k+np), workd(3*n),
& workl(2*ldh)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& one, zero
parameter (one = 1.0, zero = 0.0)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
logical first, orth1, orth2, rstart, step3, step4
integer ierr, i, infol, ipj, irj, ivj, iter, itry, j, msglvl,
& jj
Double precision
& betaj, ovfl, temp1, rnorm1, smlnum, tst1, ulp, unfl,
& wnorm
save first, orth1, orth2, rstart, step3, step4,
& ierr, ipj, irj, ivj, iter, itry, j, msglvl, ovfl,
& betaj, rnorm1, smlnum, ulp, unfl, wnorm
c
c
c %-----------------------%
c | Local Array Arguments |
c %-----------------------%
c
Double precision
& xtemp(2)
c
c %----------------------%
c | External Subroutines |
c %----------------------%
c
external daxpy, dcopy, dscal, dgemv, pdgetv0, dlabad,
& pdvout, pdmout, pivout, arscnd
c
c %--------------------%
c | External Functions |
c %--------------------%
c
Double precision
& ddot, pdnorm2, dlanhs, pdlamch
external ddot, pdnorm2, dlanhs, pdlamch
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------%
c | Data statements |
c %-----------------%
c
data first / .true. /
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
if (first) then
c
c %-----------------------------------------%
c | Set machine-dependent constants for the |
c | the splitting and deflation criterion. |
c | If norm(H) <= sqrt(OVFL), |
c | overflow should not occur. |
c | REFERENCE: LAPACK subroutine dlahqr |
c %-----------------------------------------%
c
unfl = pdlamch(comm, 'safe minimum' )
ovfl = one / unfl
call dlabad( unfl, ovfl )
ulp = pdlamch( comm, 'precision' )
smlnum = unfl*( n / ulp )
first = .false.
end if
c
if (ido .eq. 0) then
c
c %-------------------------------%
c | Initialize timing statistics |
c | & message level for debugging |
c %-------------------------------%
c
call arscnd (t0)
msglvl = mnaitr
c
c %------------------------------%
c | Initial call to this routine |
c %------------------------------%
c
info = 0
step3 = .false.
step4 = .false.
rstart = .false.
orth1 = .false.
orth2 = .false.
j = k + 1
ipj = 1
irj = ipj + n
ivj = irj + n
end if
c
c %-------------------------------------------------%
c | When in reverse communication mode one of: |
c | STEP3, STEP4, ORTH1, ORTH2, RSTART |
c | will be .true. when .... |
c | STEP3: return from computing OP*v_{j}. |
c | STEP4: return from computing B-norm of OP*v_{j} |
c | ORTH1: return from computing B-norm of r_{j+1} |
c | ORTH2: return from computing B-norm of |
c | correction to the residual vector. |
c | RSTART: return from OP computations needed by |
c | pdgetv0. |
c %-------------------------------------------------%
c
if (step3) go to 50
if (step4) go to 60
if (orth1) go to 70
if (orth2) go to 90
if (rstart) go to 30
c
c %-----------------------------%
c | Else this is the first step |
c %-----------------------------%
c
c %--------------------------------------------------------------%
c | |
c | A R N O L D I I T E R A T I O N L O O P |
c | |
c | Note: B*r_{j-1} is already in WORKD(1:N)=WORKD(IPJ:IPJ+N-1) |
c %--------------------------------------------------------------%
1000 continue
c
if (msglvl .gt. 1) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: generating Arnoldi vector number')
call pdvout (comm, logfil, 1, rnorm, ndigit,
& '_naitr: B-norm of the current residual is')
end if
c
c %---------------------------------------------------%
c | STEP 1: Check if the B norm of j-th residual |
c | vector is zero. Equivalent to determing whether |
c | an exact j-step Arnoldi factorization is present. |
c %---------------------------------------------------%
c
betaj = rnorm
if (rnorm .gt. zero) go to 40
c
c %---------------------------------------------------%
c | Invariant subspace found, generate a new starting |
c | vector which is orthogonal to the current Arnoldi |
c | basis and continue the iteration. |
c %---------------------------------------------------%
c
if (msglvl .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: ****** RESTART AT STEP ******')
end if
c
c %---------------------------------------------%
c | ITRY is the loop variable that controls the |
c | maximum amount of times that a restart is |
c | attempted. NRSTRT is used by stat.h |
c %---------------------------------------------%
c
betaj = zero
nrstrt = nrstrt + 1
itry = 1
20 continue
rstart = .true.
ido = 0
30 continue
c
c %--------------------------------------%
c | If in reverse communication mode and |
c | RSTART = .true. flow returns here. |
c %--------------------------------------%
c
call pdgetv0 ( comm, ido, bmat, itry, .false., n, j, v, ldv,
& resid, rnorm, ipntr, workd, workl, ierr)
if (ido .ne. 99) go to 9000
if (ierr .lt. 0) then
itry = itry + 1
if (itry .le. 3) go to 20
c
c %------------------------------------------------%
c | Give up after several restart attempts. |
c | Set INFO to the size of the invariant subspace |
c | which spans OP and exit. |
c %------------------------------------------------%
c
info = j - 1
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
go to 9000
end if
c
40 continue
c
c %---------------------------------------------------------%
c | STEP 2: v_{j} = r_{j-1}/rnorm and p_{j} = p_{j}/rnorm |
c | Note that p_{j} = B*r_{j-1}. In order to avoid overflow |
c | when reciprocating a small RNORM, test against lower |
c | machine bound. |
c %---------------------------------------------------------%
c
call dcopy (n, resid, 1, v(1,j), 1)
if (rnorm .ge. unfl) then
temp1 = one / rnorm
call dscal (n, temp1, v(1,j), 1)
call dscal (n, temp1, workd(ipj), 1)
else
c
c %-----------------------------------------%
c | To scale both v_{j} and p_{j} carefully |
c | use LAPACK routine SLASCL |
c %-----------------------------------------%
c
call dlascl ('General', i, i, rnorm, one, n, 1,
& v(1,j), n, infol)
call dlascl ('General', i, i, rnorm, one, n, 1,
& workd(ipj), n, infol)
end if
c
c %------------------------------------------------------%
c | STEP 3: r_{j} = OP*v_{j}; Note that p_{j} = B*v_{j} |
c | Note that this is not quite yet r_{j}. See STEP 4 |
c %------------------------------------------------------%
c
step3 = .true.
nopx = nopx + 1
call arscnd (t2)
call dcopy (n, v(1,j), 1, workd(ivj), 1)
ipntr(1) = ivj
ipntr(2) = irj
ipntr(3) = ipj
ido = 1
c
c %-----------------------------------%
c | Exit in order to compute OP*v_{j} |
c %-----------------------------------%
c
go to 9000
50 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IRJ:IRJ+N-1) := OP*v_{j} |
c | if step3 = .true. |
c %----------------------------------%
c
call arscnd (t3)
tmvopx = tmvopx + (t3 - t2)
step3 = .false.
c
c %------------------------------------------%
c | Put another copy of OP*v_{j} into RESID. |
c %------------------------------------------%
c
call dcopy (n, workd(irj), 1, resid, 1)
c
c %---------------------------------------%
c | STEP 4: Finish extending the Arnoldi |
c | factorization to length j. |
c %---------------------------------------%
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
step4 = .true.
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-------------------------------------%
c | Exit in order to compute B*OP*v_{j} |
c %-------------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
60 continue
c
c %----------------------------------%
c | Back from reverse communication; |
c | WORKD(IPJ:IPJ+N-1) := B*OP*v_{j} |
c | if step4 = .true. |
c %----------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
step4 = .false.
c
c %-------------------------------------%
c | The following is needed for STEP 5. |
c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
wnorm = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, wnorm, 1, -1, -1 )
wnorm = sqrt(abs(wnorm))
else if (bmat .eq. 'I') then
wnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------%
c | Compute the j-th residual corresponding |
c | to the j step factorization. |
c | Use Classical Gram Schmidt and compute: |
c | w_{j} <- V_{j}^T * B * OP * v_{j} |
c | r_{j} <- OP*v_{j} - V_{j} * w_{j} |
c %-----------------------------------------%
c
c
c %------------------------------------------%
c | Compute the j Fourier coefficients w_{j} |
c | WORKD(IPJ:IPJ+N-1) contains B*OP*v_{j}. |
c %------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, h(1,j), 1)
call dgsum2d( comm, 'All', ' ', j, 1, h(1,j), j, -1, -1 )
c
c %--------------------------------------%
c | Orthogonalize r_{j} against V_{j}. |
c | RESID contains OP*v_{j}. See STEP 3. |
c %--------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = betaj
c
call arscnd (t4)
c
orth1 = .true.
c
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %----------------------------------%
c | Exit in order to compute B*r_{j} |
c %----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
70 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH1 = .true. |
c | WORKD(IPJ:IPJ+N-1) := B*r_{j}. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
orth1 = .false.
c
c %------------------------------%
c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
rnorm = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm, 1, -1, -1 )
rnorm = sqrt(abs(rnorm))
else if (bmat .eq. 'I') then
rnorm = pdnorm2( comm, n, resid, 1 )
end if
c
c %-----------------------------------------------------------%
c | STEP 5: Re-orthogonalization / Iterative refinement phase |
c | Maximum NITER_ITREF tries. |
c | |
c | s = V_{j}^T * B * r_{j} |
c | r_{j} = r_{j} - V_{j}*s |
c | alphaj = alphaj + s_{j} |
c | |
c | The stopping criteria used for iterative refinement is |
c | discussed in Parlett's book SEP, page 107 and in Gragg & |
c | Reichel ACM TOMS paper; Algorithm 686, Dec. 1990. |
c | Determine if we need to correct the residual. The goal is |
c | to enforce ||v(:,1:j)^T * r_{j}|| .le. eps * || r_{j} || |
c | The following test determines whether the sine of the |
c | angle between OP*x and the computed residual is less |
c | than or equal to 0.717. |
c %-----------------------------------------------------------%
c
if (rnorm .gt. 0.717*wnorm) go to 100
iter = 0
nrorth = nrorth + 1
c
c %---------------------------------------------------%
c | Enter the Iterative refinement phase. If further |
c | refinement is necessary, loop back here. The loop |
c | variable is ITER. Perform a step of Classical |
c | Gram-Schmidt using all the Arnoldi vectors V_{j} |
c %---------------------------------------------------%
c
80 continue
c
if (msglvl .gt. 2) then
xtemp(1) = wnorm
xtemp(2) = rnorm
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: re-orthonalization; wnorm and rnorm are')
call pdvout (comm, logfil, j, h(1,j), ndigit,
& '_naitr: j-th column of H')
end if
c
c %----------------------------------------------------%
c | Compute V_{j}^T * B * r_{j}. |
c | WORKD(IRJ:IRJ+J-1) = v(:,1:J)'*WORKD(IPJ:IPJ+N-1). |
c %----------------------------------------------------%
c
call dgemv ('T', n, j, one, v, ldv, workd(ipj), 1,
& zero, workl, 1)
call dgsum2d( comm, 'All', ' ', j, 1, workl, j, -1, -1 )
c
c %---------------------------------------------%
c | Compute the correction to the residual: |
c | r_{j} = r_{j} - V_{j} * WORKD(IRJ:IRJ+J-1). |
c | The correction to H is v(:,1:J)*H(1:J,1:J) |
c | + v(:,1:J)*WORKD(IRJ:IRJ+J-1)*e'_j. |
c %---------------------------------------------%
c
call dgemv ('N', n, j, -one, v, ldv, workl(1), 1,
& one, resid, 1)
call daxpy (j, one, workl(1), 1, h(1,j), 1)
c
orth2 = .true.
call arscnd (t2)
if (bmat .eq. 'G') then
nbx = nbx + 1
call dcopy (n, resid, 1, workd(irj), 1)
ipntr(1) = irj
ipntr(2) = ipj
ido = 2
c
c %-----------------------------------%
c | Exit in order to compute B*r_{j}. |
c | r_{j} is the corrected residual. |
c %-----------------------------------%
c
go to 9000
else if (bmat .eq. 'I') then
call dcopy (n, resid, 1, workd(ipj), 1)
end if
90 continue
c
c %---------------------------------------------------%
c | Back from reverse communication if ORTH2 = .true. |
c %---------------------------------------------------%
c
if (bmat .eq. 'G') then
call arscnd (t3)
tmvbx = tmvbx + (t3 - t2)
end if
c
c %-----------------------------------------------------%
c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
rnorm1 = ddot (n, resid, 1, workd(ipj), 1)
call dgsum2d( comm, 'All', ' ', 1, 1, rnorm1, 1, -1, -1 )
rnorm1 = sqrt(abs(rnorm1))
else if (bmat .eq. 'I') then
rnorm1 = pdnorm2( comm, n, resid, 1 )
end if
c
if (msglvl .gt. 0 .and. iter .gt. 0) then
call pivout (comm, logfil, 1, j, ndigit,
& '_naitr: Iterative refinement for Arnoldi residual')
if (msglvl .gt. 2) then
xtemp(1) = rnorm
xtemp(2) = rnorm1
call pdvout (comm, logfil, 2, xtemp, ndigit,
& '_naitr: iterative refinement ; rnorm and rnorm1 are')
end if
end if
c
c %-----------------------------------------%
c | Determine if we need to perform another |
c | step of re-orthogonalization. |
c %-----------------------------------------%
c
if (rnorm1 .gt. 0.717*rnorm) then
c
c %---------------------------------------%
c | No need for further refinement. |
c | The cosine of the angle between the |
c | corrected residual vector and the old |
c | residual vector is greater than 0.717 |
c | In other words the corrected residual |
c | and the old residual vector share an |
c | angle of less than arcCOS(0.717) |
c %---------------------------------------%
c
rnorm = rnorm1
c
else
c
c %-------------------------------------------%
c | Another step of iterative refinement step |
c | is required. NITREF is used by stat.h |
c %-------------------------------------------%
c
nitref = nitref + 1
rnorm = rnorm1
iter = iter + 1
if (iter .le. 1) go to 80
c
c %-------------------------------------------------%
c | Otherwise RESID is numerically in the span of V |
c %-------------------------------------------------%
c
do 95 jj = 1, n
resid(jj) = zero
95 continue
rnorm = zero
end if
c
c %----------------------------------------------%
c | Branch here directly if iterative refinement |
c | wasn't necessary or after at most NITER_REF |
c | steps of iterative refinement. |
c %----------------------------------------------%
c
100 continue
c
rstart = .false.
orth2 = .false.
c
call arscnd (t5)
titref = titref + (t5 - t4)
c
c %------------------------------------%
c | STEP 6: Update j = j+1; Continue |
c %------------------------------------%
c
j = j + 1
if (j .gt. k+np) then
call arscnd (t1)
tnaitr = tnaitr + (t1 - t0)
ido = 99
do 110 i = max(1,k), k+np-1
c
c %--------------------------------------------%
c | Check for splitting and deflation. |
c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine dlahqr |
c %--------------------------------------------%
c
tst1 = abs( h( i, i ) ) + abs( h( i+1, i+1 ) )
if( tst1.eq.zero )
& tst1 = dlanhs( '1', k+np, h, ldh, workd(n+1) )
if( abs( h( i+1,i ) ).le.max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
c
if (msglvl .gt. 2) then
call pdmout (comm, logfil, k+np, k+np, h, ldh, ndigit,
& '_naitr: Final upper Hessenberg matrix H of order K+NP')
end if
c
go to 9000
end if
c
c %--------------------------------------------------------%
c | Loop back to extend the factorization by another step. |
c %--------------------------------------------------------%
c
go to 1000
c
c %---------------------------------------------------------------%
c | |
c | E N D O F M A I N I T E R A T I O N L O O P |
c | |
c %---------------------------------------------------------------%
c
9000 continue
return
c
c %----------------%
c | End of pdnaitr |
c %----------------%
c
end
arpack-ng-3.1.5/PARPACK/SRC/BLACS/pdlarnv.f 0000644 0001750 0001750 00000004000 12277373057 014464 0000000 0000000 c\BeginDoc
c
c\Name: pdlarnv
c
c Message Passing Layer: BLACS
c
c\Description:
c
c Parallel Version of ARPACK utility routine dlarnv
c
c PSLARNV returns a vector of n (nloc) random real numbers from a uniform or
c normal distribution. It is assumed that X is distributed across a 1-D array
c of processors ( nprocs < 1000 )
c
c\Arguments
c COMM BLACS Communicator for the processor grid
c
c IDIST (input) INTEGER
c Specifies the distribution of the random numbers:
c = 1: uniform (0,1)
c = 2: uniform (-1,1)
c = 3: normal (0,1)
c
c ISEED (input/output) INTEGER array, dimension (4)
c On entry, the seed of the random number generator; the array
c elements must be between 0 and 4095, and ISEED(4) must be
c odd.
c On exit, the seed is updated.
c
c N (input) INTEGER
c The number of random numbers to be generated.
c
c X (output) Double precision array, dimension (N)
c The generated random numbers.
c
c\Author: Kristi Maschhoff
c
c\Details
c
c Simple parallel version of LAPACK auxiliary routine dlarnv
c for X distributed across a 1-D array of processors.
c This routine calls the auxiliary routine SLARNV to generate random
c real numbers from a uniform (0,1) distribution. Output is consistent
c with serial version.
c
c\SCCS Information:
c FILE: larnv.F SID: 1.4 DATE OF SID: 04/16/99
c
c-----------------------------------------------------------------------
c
subroutine pdlarnv( comm, idist, iseed, n, x )
c
c .. BLACS VARIABLES AND FUNCTIONS ..
integer comm
c
c .. External Functions ..
external BLACS_GRIDINFO
c ..
c .. Scalar Arguments ..
integer idist, n
c ..
c .. Array Arguments ..
integer iseed( 4 )
Double precision
& x( * )
c ..
c .. External Subroutines ..
external dlarnv
c ..
c .. Executable Statements ..
c
call dlarnv ( idist, iseed, n, x )
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/ 0000755 0001750 0001750 00000000000 12277671743 012703 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/ 0000755 0001750 0001750 00000000000 12277671743 013330 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/stat.h 0000644 0001750 0001750 00000001713 12277373057 014373 0000000 0000000 c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
c\SCCS Information: @(#)
c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
c
real t0, t1, t2, t3, t4, t5
save t0, t1, t2, t3, t4, t5
c
integer nopx, nbx, nrorth, nitref, nrstrt
real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
common /timing/
& nopx, nbx, nrorth, nitref, nrstrt,
& tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/debug.h 0000644 0001750 0001750 00000001351 12277373057 014504 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/Makefile.am 0000644 0001750 0001750 00000001407 12277373057 015303 0000000 0000000 F77 = $(MPIF77)
bin_PROGRAMS = pzndrv1 psndrv3 pdndrv1 pdndrv3 pssdrv1 pdsdrv1 pcndrv1
pzndrv1_SOURCES = pzndrv1.f
pzndrv1_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
psndrv3_SOURCES = psndrv3.f
psndrv3_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdndrv1_SOURCES = pdndrv1.f
pdndrv1_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdndrv3_SOURCES = pdndrv3.f
pdndrv3_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pssdrv1_SOURCES = pssdrv1.f
pssdrv1_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdsdrv1_SOURCES = pdsdrv1.f
pdsdrv1_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pcndrv1_SOURCES = pcndrv1.f
pcndrv1_LDADD=../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = debug.h \
psndrv1.f \
stat.h
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pdndrv3.f 0000644 0001750 0001750 00000051453 12277373057 015004 0000000 0000000 program psndrv3
c
c Message Passing Layer: MPI
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A is derived from the 1-dimensional convection-diffusion
c operator on the interval [0,1] with zero boundary condition,
c and M is the tridiagonal matrix with 4 on the diagonal and 1
c on the subdiagonals.
c ... So OP = inv[M]*A and B = M.
c ... Use mode 2 of PDNAUPD.
c
c\BeginLib
c
c\Routines called:
c pdnaupd Parallel ARPACK reverse communication interface routine.
c pdneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dpttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c dpttrs LAPACK symmetric positive definite tridiagonal solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Parallel Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv3.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv3.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1), temp(maxn), temp_buf(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode, blk
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one
parameter (zero = 0.0, one = 1.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Double precision
& pdnorm2, dlapy2
external daxpy, pdnorm2, dpttrf, dpttrs, dlapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (n / nprocs )
blk = nloc
if ( mod(n, nprocs) .gt. 0 ) then
if ( myid .eq. nprocs-1 ) nloc = nloc + mod(n, nprocs)
* if ( mod(n, nprocs) .gt. myid ) nloc = nloc + 1
endif
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV3: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
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 | dpttrf. |
c %-----------------------------------------------------%
c
do 20 j = 1, n-1
md(j) = 4.0
me(j) = one
20 continue
md(n) = 4.0*one
c
call dpttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 DNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdnaupd( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (comm, nloc, n, workd(ipntr(1)), workd(ipntr(2)))
c======== Hack for Linear system ======= ccc
call dscal(n, zero, temp, 1)
call dscal(n, zero, temp_buf, 1)
do 15 j=1,nloc
temp_buf(myid*blk + j) = workd(ipntr(2) + j - 1)
15 continue
call MPI_ALLREDUCE( temp_buf, temp, n,
& MPI_DOUBLE_PRECISION, MPI_SUM, comm, ierr )
call dpttrs(n, 1, md, me, temp, n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
do 16 j=1,nloc
workd(ipntr(2) + j - 1 ) = temp(myid*blk + j)
16 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (comm, nloc, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %---------------------------%
c | Error message. Check the |
c | documentation in PDNAUPD. |
c %---------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call pdneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
d(j,3) = pdnorm2(comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j+1), mx)
call daxpy(nloc, d(j,2), mx, 1, ax, 1)
d(j,3) = pdnorm2(comm, nloc, ax, 1)**2
call av(comm, nloc, n, v(1,j+1), ax)
call mv(comm, nloc, v(1,j+1), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,2), mx, 1, ax, 1)
d(j,3) = dlapy2( d(j,3), pdnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program psndrv3. |
c %----------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector multiplication subroutine
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived
c from the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
subroutine av (comm, nloc, n, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, n, j, next, prev
Double precision
& v(nloc), w(nloc), one, two, dd, dl, du,
& s, h, rho, mv_buf
parameter ( rho = 10.0, one = 1.0,
& two = 2.0)
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
h = one / dble(n+1)
s = rho*h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,nloc-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(nloc) = dl*v(nloc-1) + dd*v(nloc)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v(nloc), 1, MPI_DOUBLE_PRECISION,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, 1, MPI_DOUBLE_PRECISION, prev, myid,
& comm, status, ierr )
w(1) = w(1) + dl*mv_buf
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), 1, MPI_DOUBLE_PRECISION,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, 1, MPI_DOUBLE_PRECISION, next, myid,
& comm, status, ierr )
w(nloc) = w(nloc) + du*mv_buf
endif
c
return
end
c------------------------------------------------------------------------
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and the superdiagonal.
c
subroutine mv (comm, nloc, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, j, next, prev
Double precision
& v(nloc), w(nloc), one, four, mv_buf
parameter ( one = 1.0, four = 4.0)
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,nloc-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(nloc) = one*v(nloc-1) + four*v(nloc)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v(nloc), 1, MPI_DOUBLE_PRECISION,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, 1, MPI_DOUBLE_PRECISION, prev, myid,
& comm, status, ierr )
w(1) = w(1) + mv_buf
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), 1, MPI_DOUBLE_PRECISION,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, 1, MPI_DOUBLE_PRECISION, next, myid,
& comm, status, ierr )
w(nloc) = w(nloc) + mv_buf
endif
c
return
end
c------------------------------------------------------------
subroutine mv2 (comm, n, v, w)
integer n, j, comm
Double precision
& v(n), w(n)
do 10 j=1,n
w(j) = v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pdndrv1.f 0000644 0001750 0001750 00000045555 12277373057 015010 0000000 0000000 program pdndrv1
c
c Message Passing Layer: MPI
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x.
c ... Use mode 1 of PDNAUPD.
c
c\BeginLib
c
c\Routines called:
c pdnaupd Parallel ARPACK reverse communication interface routine.
c pdneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv1.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.2 DATE OF SID: 8/14/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=12, maxncv=30, ldv=maxnloc)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxnloc), d(maxncv,3), resid(maxnloc),
& v(ldv,maxncv), workd(3*maxnloc),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Double precision
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, pdnorm2
external dlapy2, daxpy, pdnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PDNAUPD 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 PDNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of PDNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PDNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PDNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PDNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PDNAUPD.|
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PDNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pdneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PDNEUPD.|
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call daxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
call av(comm, nloc, nx, mv_buf, v(1,j+1), ax)
call daxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call daxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = dlapy2(d(j,3), pdnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, nx, np, j, lo, next, prev
Double precision
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external daxpy, tv
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call daxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_DOUBLE_PRECISION,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_PRECISION, prev, myid,
& comm, status, ierr )
call daxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_DOUBLE_PRECISION,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_PRECISION, next, myid,
& comm, status, ierr )
call daxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), h, dd, dl, du
c
Double precision
& one, zero, rho
parameter (one = 1.0, zero = 0.0,
& rho = 0.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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / dble(nx+1)
dd = 4.0*one
dl = -one - 0.5*rho*h
du = -one + 0.5*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/Makefile.in 0000644 0001750 0001750 00000051010 12277667632 015314 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
bin_PROGRAMS = pzndrv1$(EXEEXT) psndrv3$(EXEEXT) pdndrv1$(EXEEXT) \
pdndrv3$(EXEEXT) pssdrv1$(EXEEXT) pdsdrv1$(EXEEXT) \
pcndrv1$(EXEEXT)
subdir = PARPACK/EXAMPLES/MPI
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__installdirs = "$(DESTDIR)$(bindir)"
PROGRAMS = $(bin_PROGRAMS)
am_pcndrv1_OBJECTS = pcndrv1.$(OBJEXT)
pcndrv1_OBJECTS = $(am_pcndrv1_OBJECTS)
am__DEPENDENCIES_1 =
pcndrv1_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
am_pdndrv1_OBJECTS = pdndrv1.$(OBJEXT)
pdndrv1_OBJECTS = $(am_pdndrv1_OBJECTS)
pdndrv1_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_pdndrv3_OBJECTS = pdndrv3.$(OBJEXT)
pdndrv3_OBJECTS = $(am_pdndrv3_OBJECTS)
pdndrv3_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_pdsdrv1_OBJECTS = pdsdrv1.$(OBJEXT)
pdsdrv1_OBJECTS = $(am_pdsdrv1_OBJECTS)
pdsdrv1_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_psndrv3_OBJECTS = psndrv3.$(OBJEXT)
psndrv3_OBJECTS = $(am_psndrv3_OBJECTS)
psndrv3_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_pssdrv1_OBJECTS = pssdrv1.$(OBJEXT)
pssdrv1_OBJECTS = $(am_pssdrv1_OBJECTS)
pssdrv1_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_pzndrv1_OBJECTS = pzndrv1.$(OBJEXT)
pzndrv1_OBJECTS = $(am_pzndrv1_OBJECTS)
pzndrv1_DEPENDENCIES = ../../libparpack.la $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(pcndrv1_SOURCES) $(pdndrv1_SOURCES) $(pdndrv3_SOURCES) \
$(pdsdrv1_SOURCES) $(psndrv3_SOURCES) $(pssdrv1_SOURCES) \
$(pzndrv1_SOURCES)
DIST_SOURCES = $(pcndrv1_SOURCES) $(pdndrv1_SOURCES) \
$(pdndrv3_SOURCES) $(pdsdrv1_SOURCES) $(psndrv3_SOURCES) \
$(pssdrv1_SOURCES) $(pzndrv1_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = $(MPIF77)
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
pzndrv1_SOURCES = pzndrv1.f
pzndrv1_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
psndrv3_SOURCES = psndrv3.f
psndrv3_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdndrv1_SOURCES = pdndrv1.f
pdndrv1_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdndrv3_SOURCES = pdndrv3.f
pdndrv3_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pssdrv1_SOURCES = pssdrv1.f
pssdrv1_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pdsdrv1_SOURCES = pdsdrv1.f
pdsdrv1_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
pcndrv1_SOURCES = pcndrv1.f
pcndrv1_LDADD = ../../libparpack.la $(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = debug.h \
psndrv1.f \
stat.h
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/EXAMPLES/MPI/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/EXAMPLES/MPI/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-binPROGRAMS: $(bin_PROGRAMS)
@$(NORMAL_INSTALL)
@list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
if test -n "$$list"; then \
echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \
$(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \
fi; \
for p in $$list; do echo "$$p $$p"; done | \
sed 's/$(EXEEXT)$$//' | \
while read p p1; do if test -f $$p \
|| test -f $$p1 \
; then echo "$$p"; echo "$$p"; else :; fi; \
done | \
sed -e 'p;s,.*/,,;n;h' \
-e 's|.*|.|' \
-e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \
sed 'N;N;N;s,\n, ,g' | \
$(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \
{ d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \
if ($$2 == $$4) files[d] = files[d] " " $$1; \
else { print "f", $$3 "/" $$4, $$1; } } \
END { for (d in files) print "f", d, files[d] }' | \
while read type dir files; do \
if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \
test -z "$$files" || { \
echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \
$(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \
} \
; done
uninstall-binPROGRAMS:
@$(NORMAL_UNINSTALL)
@list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \
files=`for p in $$list; do echo "$$p"; done | \
sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \
-e 's/$$/$(EXEEXT)/' \
`; \
test -n "$$list" || exit 0; \
echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \
cd "$(DESTDIR)$(bindir)" && rm -f $$files
clean-binPROGRAMS:
@list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \
echo " rm -f" $$list; \
rm -f $$list || exit $$?; \
test -n "$(EXEEXT)" || exit 0; \
list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \
echo " rm -f" $$list; \
rm -f $$list
pcndrv1$(EXEEXT): $(pcndrv1_OBJECTS) $(pcndrv1_DEPENDENCIES) $(EXTRA_pcndrv1_DEPENDENCIES)
@rm -f pcndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pcndrv1_OBJECTS) $(pcndrv1_LDADD) $(LIBS)
pdndrv1$(EXEEXT): $(pdndrv1_OBJECTS) $(pdndrv1_DEPENDENCIES) $(EXTRA_pdndrv1_DEPENDENCIES)
@rm -f pdndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pdndrv1_OBJECTS) $(pdndrv1_LDADD) $(LIBS)
pdndrv3$(EXEEXT): $(pdndrv3_OBJECTS) $(pdndrv3_DEPENDENCIES) $(EXTRA_pdndrv3_DEPENDENCIES)
@rm -f pdndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pdndrv3_OBJECTS) $(pdndrv3_LDADD) $(LIBS)
pdsdrv1$(EXEEXT): $(pdsdrv1_OBJECTS) $(pdsdrv1_DEPENDENCIES) $(EXTRA_pdsdrv1_DEPENDENCIES)
@rm -f pdsdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pdsdrv1_OBJECTS) $(pdsdrv1_LDADD) $(LIBS)
psndrv3$(EXEEXT): $(psndrv3_OBJECTS) $(psndrv3_DEPENDENCIES) $(EXTRA_psndrv3_DEPENDENCIES)
@rm -f psndrv3$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(psndrv3_OBJECTS) $(psndrv3_LDADD) $(LIBS)
pssdrv1$(EXEEXT): $(pssdrv1_OBJECTS) $(pssdrv1_DEPENDENCIES) $(EXTRA_pssdrv1_DEPENDENCIES)
@rm -f pssdrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pssdrv1_OBJECTS) $(pssdrv1_LDADD) $(LIBS)
pzndrv1$(EXEEXT): $(pzndrv1_OBJECTS) $(pzndrv1_DEPENDENCIES) $(EXTRA_pzndrv1_DEPENDENCIES)
@rm -f pzndrv1$(EXEEXT)
$(AM_V_F77LD)$(F77LINK) $(pzndrv1_OBJECTS) $(pzndrv1_LDADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(PROGRAMS)
installdirs:
for dir in "$(DESTDIR)$(bindir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am: install-binPROGRAMS
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am: uninstall-binPROGRAMS
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \
clean-binPROGRAMS clean-generic clean-libtool cscopelist-am \
ctags ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-binPROGRAMS \
install-data install-data-am install-dvi install-dvi-am \
install-exec install-exec-am install-html install-html-am \
install-info install-info-am install-man install-pdf \
install-pdf-am install-ps install-ps-am install-strip \
installcheck installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am uninstall-binPROGRAMS
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pzndrv1.f 0000644 0001750 0001750 00000042015 12277373057 015022 0000000 0000000 program pzndrv1
c
c Message Passing Layer: MPI
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c in the domain omega = (0,1)x(0,1), with
c u = 0 on the boundary of omega.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x
c ... Use mode 1 of PZNAUPD.
c
c\BeginLib
c
c\Routines called
c pznaupd Parallel ARPACK reverse communication interface routine.
c pzneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a complex vector.
c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: ndrv1.F SID: 2.1
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
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
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex*16
& sigma
Double precision
& tol
logical rvec
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Complex*16
& mv_buf(maxn)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& pdznorm2
external pdznorm2, zaxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mcaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | ZNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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 pznaupd ( comm, ido, bmat, nloc, which,
& nev, tol, resid, ncv, v, ldv, iparam, ipntr,
& workd, workl, lworkl, rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pzneupd (comm, rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, nloc, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD. |
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call zaxpy(nloc, -d(j), v(1,j), 1, ax, 1)
rd(j,1) = dble(d(j))
rd(j,2) = dimag(d(j))
rd(j,3) = pdznorm2(comm, nloc, ax, 1)
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program pzndrv1. |
c %----------------------------%
c
9000 continue
c
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w )
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, nx, np, j, lo, next, prev
Complex*16
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = (1.0, 0.0))
external zaxpy, tv
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call zaxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call zaxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call zaxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call zaxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_DOUBLE_COMPLEX,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_COMPLEX, prev, myid,
& comm, status, ierr )
call zaxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_DOUBLE_COMPLEX,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_COMPLEX, next, myid,
& comm, status, ierr )
call zaxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex*16
& x(nx), y(nx), h, dd, dl, du
c
Complex*16
& one, rho
parameter (one = (1.0, 0.0), rho = (100.0, 0.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)
dd = (4.0, 0.0)
dl = -one - (0.5, 0.0)*rho*h
du = -one + (0.5, 0.0)*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/psndrv1.f 0000644 0001750 0001750 00000045335 12277373057 015023 0000000 0000000 program psndrv1
c
c Message Passing Layer: MPI
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x.
c ... Use mode 1 of PSNAUPD.
c
c\BeginLib
c
c\Routines called:
c psnaupd Parallel ARPACK reverse communication interface routine.
c psneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv1.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.2 DATE OF SID: 8/14/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=12, maxncv=30, ldv=maxnloc)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxnloc), d(maxncv,3), resid(maxnloc),
& v(ldv,maxncv), workd(3*maxnloc),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Real
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, psnorm2
external slapy2, saxpy, psnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PSNAUPD 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 PSNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of PSNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PSNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call psnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PSNAUPD.|
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call psneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSNEUPD.|
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
call av(comm, nloc, nx, mv_buf, v(1,j+1), ax)
call saxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2(d(j,3), psnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, nx, np, j, lo, next, prev
Real
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external saxpy, tv
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call saxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_REAL,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_REAL, prev, myid,
& comm, status, ierr )
call saxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_REAL,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_REAL, next, myid,
& comm, status, ierr )
call saxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), h, dd, dl, du
c
Real
& one, zero, rho
parameter (one = 1.0, zero = 0.0,
& rho = 0.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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / dble(nx+1)
dd = 4.0*one
dl = -one - 0.5*rho*h
du = -one + 0.5*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pcndrv1.f 0000644 0001750 0001750 00000041672 12277373057 015003 0000000 0000000 program pcndrv1
c
c Message Passing Layer: MPI
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c in the domain omega = (0,1)x(0,1), with
c u = 0 on the boundary of omega.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x
c ... Use mode 1 of PCNAUPD.
c
c\BeginLib
c
c\Routines called
c pcnaupd Parallel ARPACK reverse communication interface routine.
c pcneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a complex vector.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: ndrv1.F SID: 2.1
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex
& sigma
Real
& tol
logical rvec
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Complex
& mv_buf(maxn)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& pscnorm2
external pscnorm2, caxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mcaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pcnaupd ( comm, ido, bmat, nloc, which,
& nev, tol, resid, ncv, v, ldv, iparam, ipntr,
& workd, workl, lworkl, rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pcneupd (comm, rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, nloc, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call caxpy(nloc, -d(j), v(1,j), 1, ax, 1)
rd(j,1) = real(d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = pscnorm2(comm, nloc, ax, 1)
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program pcndrv1. |
c %----------------------------%
c
9000 continue
c
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w )
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, nx, np, j, lo, next, prev
Complex
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = (1.0, 0.0))
external caxpy, tv
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call caxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call caxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call caxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call caxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_COMPLEX,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_COMPLEX, prev, myid,
& comm, status, ierr )
call caxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_COMPLEX,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_COMPLEX, next, myid,
& comm, status, ierr )
call caxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex
& x(nx), y(nx), h, dd, dl, du
c
Complex
& one, rho
parameter (one = (1.0, 0.0), rho = (100.0, 0.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 / cmplx(nx+1)
dd = (4.0, 0.0)
dl = -one - (0.5, 0.0)*rho*h
du = -one + (0.5, 0.0)*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pdsdrv1.f 0000644 0001750 0001750 00000041203 12277373057 014777 0000000 0000000 program pdsdrv1
c
c Message Passing Layer: MPI
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x.
c ... Use mode 1 of DSAUPD.
c
c\BeginLib
c
c\Routines called:
c pdsaupd Parallel ARPACK reverse communication interface routine.
c pdseupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c daxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sdrv1.F SID: 2.2
c
c FILE: sdrv1.F SID: 1.4 DATE OF SID: 3/19/97 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=10, maxncv=25,
& ldv=maxnloc )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxnloc), d(maxncv,2), resid(maxnloc),
& ax(maxnloc)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Double precision
& tol, sigma
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Double precision
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& pdnorm2
external pdnorm2, daxpy
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
msaupd = 1
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _SDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in PSSAUPD 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 PSSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of PSSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in PSSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSSAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdsaupd ( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSSAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in PSSAUPD.|
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pdseupd ( comm, rvec, 'All', select,
& d, v, ldv, sigma,
& bmat, nloc, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSSEUPD.|
c %------------------------------------%
c
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = pdnorm2( comm, nloc, ax, 1 )
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call pdmout(comm, 6, nconv, 2, d, maxncv, -6,
& 'Ritz values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_SDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
endif
c
end if
c
c %---------------------------%
c | Done with program pdsdrv1.|
c %---------------------------%
c
9000 continue
c
call MPI_FINALIZE(rc)
c
end
c
c ------------------------------------------------------------------
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c-------------------------------------------------------------------
c
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
integer nloc, nx, np, j, lo, next, prev
Double precision
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external daxpy
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call daxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
if ( np .gt. 2) then
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
end if
c
if ( np .gt. 1) then
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
end if
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_DOUBLE_PRECISION,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_PRECISION, prev, myid,
& comm, status, ierr )
call daxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_DOUBLE_PRECISION,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_DOUBLE_PRECISION, next, myid,
& comm, status, ierr )
call daxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), dd, dl, du
c
Double precision
& one
parameter (one = 1.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
c
dd = 4.0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/psndrv3.f 0000644 0001750 0001750 00000051153 12277373057 015020 0000000 0000000 program psndrv3
c
c Message Passing Layer: MPI
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A is derived from the 1-dimensional convection-diffusion
c operator on the interval [0,1] with zero boundary condition,
c and M is the tridiagonal matrix with 4 on the diagonal and 1
c on the subdiagonals.
c ... So OP = inv[M]*A and B = M.
c ... Use mode 2 of PSNAUPD.
c
c\BeginLib
c
c\Routines called:
c psnaupd Parallel ARPACK reverse communication interface routine.
c psneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c spttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c spttrs LAPACK symmetric positive definite tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Parallel Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv3.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv3.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1), temp(maxn), temp_buf(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode, blk
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one
parameter (zero = 0.0, one = 1.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Real
& psnorm2, slapy2
external saxpy, psnorm2, spttrf, spttrs, slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (n / nprocs )
blk = nloc
if ( mod(n, nprocs) .gt. 0 ) then
if ( myid .eq. nprocs-1 ) nloc = nloc + mod(n, nprocs)
* if ( mod(n, nprocs) .gt. myid ) nloc = nloc + 1
endif
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV3: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
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 | spttrf. |
c %-----------------------------------------------------%
c
do 20 j = 1, n-1
md(j) = 4.0
me(j) = one
20 continue
md(n) = 4.0*one
c
call spttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 SNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call psnaupd( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (comm, nloc, n, workd(ipntr(1)), workd(ipntr(2)))
c======== Hack for Linear system ======= ccc
call sscal(n, zero, temp, 1)
call sscal(n, zero, temp_buf, 1)
do 15 j=1,nloc
temp_buf(myid*blk + j) = workd(ipntr(2) + j - 1)
15 continue
call MPI_ALLREDUCE( temp_buf, temp, n,
& MPI_REAL, MPI_SUM, comm, ierr )
call spttrs(n, 1, md, me, temp, n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
do 16 j=1,nloc
workd(ipntr(2) + j - 1 ) = temp(myid*blk + j)
16 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (comm, nloc, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %---------------------------%
c | Error message. Check the |
c | documentation in PSNAUPD. |
c %---------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call psneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
d(j,3) = psnorm2(comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j+1), mx)
call saxpy(nloc, d(j,2), mx, 1, ax, 1)
d(j,3) = psnorm2(comm, nloc, ax, 1)**2
call av(comm, nloc, n, v(1,j+1), ax)
call mv(comm, nloc, v(1,j+1), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), psnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program psndrv3. |
c %----------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources MPI |
c %-------------------------%
c
call MPI_FINALIZE(rc)
c
end
c
c==========================================================================
c
c parallel matrix vector multiplication subroutine
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived
c from the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
subroutine av (comm, nloc, n, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, n, j, next, prev
Real
& v(nloc), w(nloc), one, two, dd, dl, du,
& s, h, rho, mv_buf
parameter ( rho = 10.0, one = 1.0,
& two = 2.0)
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
h = one / real(n+1)
s = rho*h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,nloc-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(nloc) = dl*v(nloc-1) + dd*v(nloc)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v(nloc), 1, MPI_REAL,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, 1, MPI_REAL, prev, myid,
& comm, status, ierr )
w(1) = w(1) + dl*mv_buf
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), 1, MPI_REAL,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, 1, MPI_REAL, next, myid,
& comm, status, ierr )
w(nloc) = w(nloc) + du*mv_buf
endif
c
return
end
c------------------------------------------------------------------------
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and the superdiagonal.
c
subroutine mv (comm, nloc, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
c
integer nloc, j, next, prev
Real
& v(nloc), w(nloc), one, four, mv_buf
parameter ( one = 1.0, four = 4.0)
c
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,nloc-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(nloc) = one*v(nloc-1) + four*v(nloc)
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v(nloc), 1, MPI_REAL,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, 1, MPI_REAL, prev, myid,
& comm, status, ierr )
w(1) = w(1) + mv_buf
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), 1, MPI_REAL,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, 1, MPI_REAL, next, myid,
& comm, status, ierr )
w(nloc) = w(nloc) + mv_buf
endif
c
return
end
c------------------------------------------------------------
subroutine mv2 (comm, n, v, w)
integer n, j, comm
Real
& v(n), w(n)
do 10 j=1,n
w(j) = v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/MPI/pssdrv1.f 0000644 0001750 0001750 00000040763 12277373057 015030 0000000 0000000 program pssdrv1
c
c Message Passing Layer: MPI
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x.
c ... Use mode 1 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c pssaupd Parallel ARPACK reverse communication interface routine.
c psseupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c saxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sdrv1.F SID: 2.2
c
c FILE: sdrv1.F SID: 1.4 DATE OF SID: 3/19/97 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
include 'mpif.h'
include 'debug.h'
include 'stat.h'
c %---------------%
c | MPI INTERFACE |
c %---------------%
integer comm, myid, nprocs, rc, nloc
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=10, maxncv=25,
& ldv=maxnloc )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxnloc), d(maxncv,2), resid(maxnloc),
& ax(maxnloc)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Real
& tol, sigma
c
c %----------------------------------------------%
c | Local Buffers needed for MPI communication |
c %----------------------------------------------%
c
Real
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& psnorm2
external psnorm2, saxpy
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call MPI_INIT( ierr )
comm = MPI_COMM_WORLD
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
ndigit = -3
logfil = 6
msaupd = 1
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myid ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _SDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in PSSAUPD 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 PSSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of PSSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in PSSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSSAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pssaupd ( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSSAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in PSSAUPD.|
c %--------------------------%
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call psseupd ( comm, rvec, 'All', select,
& d, v, ldv, sigma,
& bmat, nloc, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSSEUPD.|
c %------------------------------------%
c
c
if ( myid .eq. 0 ) then
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = psnorm2( comm, nloc, ax, 1 )
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call psmout(comm, 6, nconv, 2, d, maxncv, -6,
& 'Ritz values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myid .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_SDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
endif
c
end if
c
c %---------------------------%
c | Done with program pssdrv1.|
c %---------------------------%
c
9000 continue
c
call MPI_FINALIZE(rc)
c
end
c
c ------------------------------------------------------------------
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c-------------------------------------------------------------------
c
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. MPI Declarations ...
include 'mpif.h'
integer comm, nprocs, myid, ierr,
& status(MPI_STATUS_SIZE)
integer nloc, nx, np, j, lo, next, prev
Real
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external saxpy
call MPI_COMM_RANK( comm, myid, ierr )
call MPI_COMM_SIZE( comm, nprocs, ierr )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call saxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
if ( np .gt. 2) then
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
end if
c
if ( np .gt. 1) then
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
end if
c
next = myid + 1
prev = myid - 1
if ( myid .lt. nprocs-1 ) then
call mpi_send( v((np-1)*nx+1), nx, MPI_REAL,
& next, myid+1, comm, ierr )
endif
if ( myid .gt. 0 ) then
call mpi_recv( mv_buf, nx, MPI_REAL, prev, myid,
& comm, status, ierr )
call saxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myid .gt. 0 ) then
call mpi_send( v(1), nx, MPI_REAL,
& prev, myid-1, comm, ierr )
endif
if ( myid .lt. nprocs-1 ) then
call mpi_recv( mv_buf, nx, MPI_REAL, next, myid,
& comm, status, ierr )
call saxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), dd, dl, du
c
Real
& one
parameter (one = 1.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
c
dd = 4.0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/ 0000755 0001750 0001750 00000000000 12277671743 013527 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/stat.h 0000644 0001750 0001750 00000001713 12277373057 014572 0000000 0000000 c %--------------------------------%
c | See stat.doc for documentation |
c %--------------------------------%
c
c\SCCS Information: @(#)
c FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2
c
real t0, t1, t2, t3, t4, t5
save t0, t1, t2, t3, t4, t5
c
integer nopx, nbx, nrorth, nitref, nrstrt
real tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
common /timing/
& nopx, nbx, nrorth, nitref, nrstrt,
& tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
& tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
& tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
& tmvopx, tmvbx, tgetv0, titref, trvec
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/debug.h 0000644 0001750 0001750 00000001351 12277373057 014703 0000000 0000000 c
c\SCCS Information: @(#)
c FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2
c
c %---------------------------------%
c | See debug.doc for documentation |
c %---------------------------------%
integer logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
common /debug/
& logfil, ndigit, mgetv0,
& msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
& mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
& mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/psntest1.f 0000644 0001750 0001750 00000035606 12277373057 015406 0000000 0000000 program psntest1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Test-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is random diagonal matrix with 4 separated eigenvalues.
c ... OP = A and B = I.
c ... Assume "call av ( nloc, diag, x, y)" computes y = A*x.
c ... Use mode 1 of PSNAUPD.
c
c\BeginLib
c
c\Routines called:
c psnaupd Parallel ARPACK reverse communication interface routine.
c psneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed matrix vector multiplication routine that computes A*x.
c
c\Author
c Kristi Maschhoff
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information:
c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), iseed(4)
logical select(maxncv)
Real
& ax(maxn), d(maxncv,3), resid(maxn), diag(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode, idist
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one
parameter (zero = 0.0, one = 1.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, psnorm2
external slapy2, saxpy, psnorm2, slarnv
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
n = 10000*nprocs
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = 10000
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------%
c | Generate random diagonal matrix |
c | Isolate 4 extreamal eigenvalues |
c %-----------------------------------%
c
idist = 1
iseed(1) = 15
iseed(2) = 35
iseed(3) = 52
iseed(4) = 7
call slarnv ( idist, iseed, nloc, diag )
diag(1) = diag(1) + 1.01
diag(2) = diag(2) + 1.01
diag(3) = diag(3) + 1.01
diag(4) = diag(4) + 1.01
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PSNAUPD 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 PSNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 1
do 50 j=1,nloc
resid(j) = one
50 continue
c
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 1 of PSNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PSNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call psnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( nloc, diag, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PSNAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call psneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSNEUPD.|
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av( nloc, diag, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av( nloc, diag, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
call av( nloc, diag, v(1,j+1), ax)
call saxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2(d(j,3), psnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
subroutine av (n, diag, v, w)
integer n, j
Real
& v(n), w(n), diag(n)
c
do 10 j = 1, n
w(j) = diag(j)*v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/Makefile.am 0000644 0001750 0001750 00000002066 12277373057 015504 0000000 0000000 # F77 = $(MPIF77)
# bin_PROGRAMS = pzndrv1 psndrv3 pdndrv1 pdndrv3 pssdrv1 pdsdrv1 pcndrv1
# pzndrv1_SOURCES = pzndrv1.f
# pzndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# psndrv3_SOURCES = psndrv3.f
# psndrv3_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdndrv1_SOURCES = pdndrv1.f
# pdndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdndrv3_SOURCES = pdndrv3.f
# pdndrv3_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pssdrv1_SOURCES = pssdrv1.f
# pssdrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdsdrv1_SOURCES = pdsdrv1.f
# pdsdrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pcndrv1_SOURCES = pcndrv1.f
# pcndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
EXTRA_DIST = debug.h pdndrv1.f pdntest1.f psndrv1.f psntest1.f \
pzndrv1.f pcndrv1.f pdndrv3.f pdsdrv1.f psndrv3.f pssdrv1.f stat.h
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pdndrv3.f 0000644 0001750 0001750 00000052051 12277373057 015176 0000000 0000000 program psndrv3
c
c Message Passing Layer: BLACS
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A is derived from the 1-dimensional convection-diffusion
c operator on the interval [0,1] with zero boundary condition,
c and M is the tridiagonal matrix with 4 on the diagonal and 1
c on the subdiagonals.
c ... So OP = inv[M]*A and B = M.
c ... Use mode 2 of PDNAUPD.
c
c\BeginLib
c
c\Routines called:
c pdnaupd Parallel ARPACK reverse communication interface routine.
c pdneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dpttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c dpttrs LAPACK symmetric positive definite tridiagonal solve routine.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Parallel Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv3.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv3.F SID: 1.2 DATE OF SID: 09/14/98 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1), temp(maxn), temp_buf(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode, blk
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one
parameter (zero = 0.0, one = 1.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Double precision
& pdnorm2, dlapy2
external daxpy, pdnorm2, dpttrf, dpttrs, dlapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (n / nprocs )
blk = nloc
if ( mod(n, nprocs) .gt. 0 ) then
if ( myprow .eq. nprow-1 ) nloc = nloc + mod(n, nprocs)
* if ( mod(n, nprocs) .gt. myprow ) nloc = nloc + 1
endif
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV3: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
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 | dpttrf. |
c %-----------------------------------------------------%
c
do 20 j = 1, n-1
md(j) = 4.0
me(j) = one
20 continue
md(n) = 4.0*one
c
call dpttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
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 %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 DNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in DNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine DNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdnaupd( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (comm, nloc, n, workd(ipntr(1)), workd(ipntr(2)))
c======== Hack for Linear system ======= ccc
call dscal(n, zero, temp, 1)
do 15 j=1,nloc
temp(myprow*blk + j) = workd(ipntr(2) + j - 1)
15 continue
call dgsum2d( comm, 'All', ' ', n, 1, temp, n, -1, -1 )
call dpttrs(n, 1, md, me, temp, n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
do 16 j=1,nloc
workd(ipntr(2) + j - 1 ) = temp(myprow*blk + j)
16 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (comm, nloc, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call DNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %---------------------------%
c | Error message. Check the |
c | documentation in PDNAUPD. |
c %---------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using DNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call pdneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of DNEUPD. |
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
d(j,3) = pdnorm2(comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j+1), mx)
call daxpy(nloc, d(j,2), mx, 1, ax, 1)
d(j,3) = pdnorm2(comm, nloc, ax, 1)**2
call av(comm, nloc, n, v(1,j+1), ax)
call mv(comm, nloc, v(1,j+1), mx)
call daxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j), mx)
call daxpy(nloc, -d(j,2), mx, 1, ax, 1)
d(j,3) = dlapy2( d(j,3), pdnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program psndrv3. |
c %----------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector multiplication subroutine
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived
c from the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
subroutine av (comm, nloc, n, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, dgesd2d, dgerv2d
c
integer nloc, n, j, next, prev
Double precision
& v(nloc), w(nloc), one, two, dd, dl, du,
& s, h, rho, mv_buf
parameter ( rho = 10.0, one = 1.0,
& two = 2.0)
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
h = one / dble(n+1)
s = rho*h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,nloc-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(nloc) = dl*v(nloc-1) + dd*v(nloc)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call dgesd2d( comm, 1, 1, v(nloc), 1, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call dgerv2d( comm, 1, 1, mv_buf, 1, prev, mypcol )
w(1) = w(1) + dl*mv_buf
endif
c
if ( myprow .gt. 0 ) then
call dgesd2d( comm, 1, 1, v(1), 1, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call dgerv2d( comm, 1, 1, mv_buf, 1, next, mypcol )
w(nloc) = w(nloc) + du*mv_buf
endif
c
return
end
c------------------------------------------------------------------------
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and the superdiagonal.
c
subroutine mv (comm, nloc, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, dgesd2d, dgerv2d
c
integer nloc, j, next, prev
Double precision
& v(nloc), w(nloc), one, four, mv_buf
parameter ( one = 1.0, four = 4.0)
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,nloc-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(nloc) = one*v(nloc-1) + four*v(nloc)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call dgesd2d( comm, 1, 1, v(nloc), 1, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call dgerv2d( comm, 1, 1, mv_buf, 1, prev, mypcol )
w(1) = w(1) + mv_buf
endif
c
if ( myprow .gt. 0 ) then
call dgesd2d( comm, 1, 1, v(1), 1, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call dgerv2d( comm, 1, 1, mv_buf, 1, next, mypcol )
w(nloc) = w(nloc) + mv_buf
endif
c
return
end
c------------------------------------------------------------
subroutine mv2 (comm, n, v, w)
integer n, j, comm
Double precision
& v(n), w(n)
do 10 j=1,n
w(j) = v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pdndrv1.f 0000644 0001750 0001750 00000046657 12277373057 015213 0000000 0000000 program pdndrv1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x.
c ... Use mode 1 of PDNAUPD.
c
c\BeginLib
c
c\Routines called:
c pdnaupd Parallel ARPACK reverse communication interface routine.
c pdneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv1.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.2 DATE OF SID: 8/14/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=12, maxncv=30, ldv=maxnloc)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Double precision
& ax(maxnloc), d(maxncv,3), resid(maxnloc),
& v(ldv,maxncv), workd(3*maxnloc),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Double precision
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, pdnorm2
external dlapy2, daxpy, pdnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PDNAUPD 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 PDNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of PDNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PDNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PDNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PDNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PDNAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PDNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pdneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PDNEUPD.|
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call daxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
call av(comm, nloc, nx, mv_buf, v(1,j+1), ax)
call daxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call daxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = dlapy2(d(j,3), pdnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, dgesd2d, dgerv2d
c
integer nloc, nx, np, j, lo, next, prev
Double precision
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external daxpy, tv
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call daxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call dgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call dgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call daxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call dgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call dgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call daxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), h, dd, dl, du
c
Double precision
& one, zero, rho
parameter (one = 1.0, zero = 0.0,
& rho = 0.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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / dble(nx+1)
dd = 4.0*one
dl = -one - 0.5*rho*h
du = -one + 0.5*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/Makefile.in 0000644 0001750 0001750 00000031427 12277667632 015525 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
# F77 = $(MPIF77)
# bin_PROGRAMS = pzndrv1 psndrv3 pdndrv1 pdndrv3 pssdrv1 pdsdrv1 pcndrv1
# pzndrv1_SOURCES = pzndrv1.f
# pzndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# psndrv3_SOURCES = psndrv3.f
# psndrv3_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdndrv1_SOURCES = pdndrv1.f
# pdndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdndrv3_SOURCES = pdndrv3.f
# pdndrv3_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pssdrv1_SOURCES = pssdrv1.f
# pssdrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pdsdrv1_SOURCES = pdsdrv1.f
# pdsdrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
# pcndrv1_SOURCES = pcndrv1.f
# pcndrv1_LDADD=../../../PARPACK/SRC/BLACS/libparpacksrc.la $(BLAS_LIBS) $(LAPACK_LIBS)
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/EXAMPLES/BLACS
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
SOURCES =
DIST_SOURCES =
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
EXTRA_DIST = debug.h pdndrv1.f pdntest1.f psndrv1.f psntest1.f \
pzndrv1.f pcndrv1.f pdndrv3.f pdsdrv1.f psndrv3.f pssdrv1.f stat.h
all: all-am
.SUFFIXES:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/EXAMPLES/BLACS/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/EXAMPLES/BLACS/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
tags TAGS:
ctags CTAGS:
cscope cscopelist:
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-generic
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: all all-am check check-am clean clean-generic clean-libtool \
cscopelist-am ctags-am distclean distclean-generic \
distclean-libtool distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
maintainer-clean maintainer-clean-generic mostlyclean \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pzndrv1.f 0000644 0001750 0001750 00000043133 12277373057 015223 0000000 0000000 program pzndrv1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c in the domain omega = (0,1)x(0,1), with
c u = 0 on the boundary of omega.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x
c ... Use mode 1 of PZNAUPD.
c
c\BeginLib
c
c\Routines called
c pznaupd Parallel ARPACK reverse communication interface routine.
c pzneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pdznorm2 Parallel version of Level 1 BLAS that computes the norm of a complex vector.
c zaxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: ndrv1.F SID: 2.1
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
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
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex*16
& sigma
Double precision
& tol
logical rvec
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Complex*16
& mv_buf(maxn)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& pdznorm2
external pdznorm2, zaxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mcaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | ZNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
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 pznaupd ( comm, ido, bmat, nloc, which,
& nev, tol, resid, ncv, v, ldv, iparam, ipntr,
& workd, workl, lworkl, rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call ZNAUPD again. |
c %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in ZNAUPD |
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using ZNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pzneupd (comm, rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, nloc, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of ZNEUPD. |
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call zaxpy(nloc, -d(j), v(1,j), 1, ax, 1)
rd(j,1) = dble(d(j))
rd(j,2) = dimag(d(j))
rd(j,3) = pdznorm2(comm, nloc, ax, 1)
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program pzndrv1. |
c %----------------------------%
c
9000 continue
c
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w )
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, zgesd2d, zgerv2d
c
integer nloc, nx, np, j, lo, next, prev
Complex*16
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = (1.0, 0.0))
external zaxpy, tv
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call zaxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call zaxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call zaxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call zaxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call zgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call zgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call zaxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call zgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call zgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call zaxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex*16
& x(nx), y(nx), h, dd, dl, du
c
Complex*16
& one, rho
parameter (one = (1.0, 0.0), rho = (100.0, 0.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)
dd = (4.0, 0.0)
dl = -one - (0.5, 0.0)*rho*h
du = -one + (0.5, 0.0)*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/psndrv1.f 0000644 0001750 0001750 00000046517 12277373057 015225 0000000 0000000 program psndrv1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c on the unit square, with zero Dirichlet boundary condition.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x.
c ... Use mode 1 of PSNAUPD.
c
c\BeginLib
c
c\Routines called:
c psnaupd Parallel ARPACK reverse communication interface routine.
c psneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv1.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.2 DATE OF SID: 8/14/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=12, maxncv=30, ldv=maxnloc)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxnloc), d(maxncv,3), resid(maxnloc),
& v(ldv,maxncv), workd(3*maxnloc),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Real
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& slapy2, psnorm2
external slapy2, saxpy, psnorm2
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PSNAUPD 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 PSNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 0
c
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 1 of PSNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PSNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call psnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PSNAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call psneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSNEUPD.|
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call saxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = psnorm2( comm, nloc, ax, 1)
call av(comm, nloc, nx, mv_buf, v(1,j+1), ax)
call saxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call saxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = slapy2(d(j,3), psnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional convection-diffusion
c operator discretized using central difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the 2 dimensional convection-diffusion operator
c (Laplacian u) + rho*(du/dx) on a unit square with zero boundary
c condition.
c
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
c The subroutine TV is called to compute y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, sgesd2d, sgerv2d
c
integer nloc, nx, np, j, lo, next, prev
Real
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external saxpy, tv
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call saxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call sgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call sgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call saxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call sgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call sgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call saxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), h, dd, dl, du
c
Real
& one, zero, rho
parameter (one = 1.0, zero = 0.0,
& rho = 0.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
c When rho*h/2 <= 1, the discrete convection-diffusion operator
c has real eigenvalues. When rho*h/2 > 1, it has COMPLEX
c eigenvalues.
c
h = one / dble(nx+1)
dd = 4.0*one
dl = -one - 0.5*rho*h
du = -one + 0.5*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pdntest1.f 0000644 0001750 0001750 00000035705 12277373057 015367 0000000 0000000 program psntest1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard nonsymmetric eigenvalue problem.
c
c We implement example one of ex-nonsym.doc in DOCUMENTS directory
c
c\Test-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is random diagonal matrix with 4 separated eigenvalues.
c ... OP = A and B = I.
c ... Assume "call av ( nloc, diag, x, y)" computes y = A*x.
c ... Use mode 1 of PDNAUPD.
c
c\BeginLib
c
c\Routines called:
c pdnaupd Parallel ARPACK reverse communication interface routine.
c pdneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c dlapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c daxpy Level 1 BLAS that computes y <- alpha*x+y.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Distributed matrix vector multiplication routine that computes A*x.
c
c\Author
c Kristi Maschhoff
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\SCCS Information:
c FILE: %M% SID: %I% DATE OF SID: %G% RELEASE: %R%
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the distributed |
c | block of A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=100000, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14), iseed(4)
logical select(maxncv)
Double precision
& ax(maxn), d(maxncv,3), resid(maxn), diag(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode, idist
Double precision
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero, one
parameter ( zero = 0.0, one = 1.0 )
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& dlapy2, pdnorm2
external dlapy2, daxpy, pdnorm2, dlarnv
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs, sqrt
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
n = maxn*nprocs
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = maxn
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %-----------------------------------%
c | Generate random diagonal matrix |
c | Isolate 4 extreamal eigenvalues |
c %-----------------------------------%
c
idist = 1
iseed(1) = 15
iseed(2) = 35
iseed(3) = 52
iseed(4) = 7
call dlarnv ( idist, iseed, nloc, diag )
diag(1) = diag(1) + 1.01
diag(2) = diag(2) + 1.01
diag(3) = diag(3) + 1.01
diag(4) = diag(4) + 1.01
c
c %-----------------------------------------------------%
c | The work array WORKL is used in PDNAUPD 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 PDNAUPD to start the Arnoldi iteration.|
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = zero
ido = 0
info = 1
do 50 j=1,nloc
resid(j) = 1.0
50 continue
c
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 1 of PDNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | PDNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PDNAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdnaupd(comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( nloc, diag, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PDNAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in PDNAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PDNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pdneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the imaginary part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PDNEUPD.|
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av( nloc, diag, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex. |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av( nloc, diag, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
call daxpy(nloc, d(j,2), v(1,j+1), 1, ax, 1)
d(j,3) = pdnorm2( comm, nloc, ax, 1)
call av( nloc, diag, v(1,j+1), ax)
call daxpy(nloc, -d(j,2), v(1,j), 1, ax, 1)
call daxpy(nloc, -d(j,1), v(1,j+1), 1, ax, 1)
d(j,3) = dlapy2(d(j,3), pdnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call pdmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %---------------------------%
c | Done with program pdndrv1.|
c %---------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
subroutine av (n, diag, v, w)
integer n, j
Double precision
& v(n), w(n), diag(n)
c
do 10 j = 1, n
w(j) = diag(j)*v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pcndrv1.f 0000644 0001750 0001750 00000043044 12277373057 015175 0000000 0000000 program pcndrv1
c
c Message Passing Layer: BLACS
c
c Example program to illustrate the idea of reverse communication
c for a standard complex nonsymmetric eigenvalue problem.
c
c We implement example one of ex-complex.doc in DOCUMENTS directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is obtained from the standard central difference
c discretization of the convection-diffusion operator
c (Laplacian u) + rho*(du / dx)
c in the domain omega = (0,1)x(0,1), with
c u = 0 on the boundary of omega.
c
c ... OP = A and B = I.
c ... Assume "call av (comm, nloc, nx, mv_buf, x, y)" computes y = A*x
c ... Use mode 1 of PCNAUPD.
c
c\BeginLib
c
c\Routines called
c pcnaupd Parallel ARPACK reverse communication interface routine.
c pcneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pscnorm2 Parallel version of Level 1 BLAS that computes the norm of a complex vector.
c caxpy Level 1 BLAS that computes y <- alpha*x+y.
c av Distributed 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Complex Code FILE: ndrv1.F SID: 2.1
c
c\SCCS Information:
c FILE: ndrv1.F SID: 1.1 DATE OF SID: 8/13/96 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c---------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c %-----------------------------%
c | Define maximum dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=12, maxncv=30, ldv=maxn)
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Complex
& ax(maxn), d(maxncv),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv), resid(maxn),
& workl(3*maxncv*maxncv+5*maxncv)
Real
& rwork(maxncv), rd(maxncv,3)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nx, nev, ncv, lworkl, info, j,
& ierr, nconv, maxitr, ishfts, mode
Complex
& sigma
Real
& tol
logical rvec
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Complex
& mv_buf(maxn)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& pscnorm2
external pscnorm2, caxpy
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mcaupd = 1
c
c %--------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | convection-diffusion operator on the unit |
c | square with zero Dirichlet boundary condition. |
c | The number N(=NX*NX) is the dimension of the |
c | matrix. A standard eigenvalue problem is |
c | solved (BMAT = 'I'). NEV is the number of |
c | eigenvalues to be approximated. The user can |
c | modify NX, NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of |
c | the spectrum. However, The following |
c | conditions must be satisfied: |
c | N <= MAXN |
c | NEV <= MAXNEV |
c | NEV + 2 <= NCV <= MAXNCV |
c %--------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV1: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'LM'
c
c %---------------------------------------------------%
c | The work array WORKL is used in CNAUPD 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 to start the ARNOLDI iteration. |
c %---------------------------------------------------%
c
lworkl = 3*ncv**2+5*ncv
tol = 0.0
ido = 0
info = 0
c
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 CNAUPD is used |
c | (IPARAM(7) = 1). All these options can be changed |
c | by the user. For details see the documentation in |
c | CNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine CNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pcnaupd ( comm, ido, bmat, nloc, which,
& nev, tol, resid, ncv, v, ldv, iparam, ipntr,
& workd, workl, lworkl, rwork,info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %-------------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine here |
c | that takes workd(ipntr(1)) as the input |
c | vector, and return the matrix vector |
c | product to workd(ipntr(2)). |
c %-------------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call CNAUPD again. |
c %-----------------------------------------%
c
go to 10
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message, check the |
c | documentation in CNAUPD |
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using CNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pcneupd (comm, rvec, 'A', select, d, v, ldv, sigma,
& workev, bmat, nloc, which, nev, tol, resid, ncv,
& v, ldv, iparam, ipntr, workd, workl, lworkl,
& rwork, ierr)
c
c %----------------------------------------------%
c | Eigenvalues are returned in the one |
c | dimensional array D. The corresponding |
c | eigenvectors are returned in the first NCONV |
c | (=IPARAM(5)) columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of CNEUPD. |
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call caxpy(nloc, -d(j), v(1,j), 1, ax, 1)
rd(j,1) = real(d(j))
rd(j,2) = aimag(d(j))
rd(j,3) = pscnorm2(comm, nloc, ax, 1)
c
20 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, rd, maxncv, -6,
& 'Ritz values (Real, Imag) and direct residuals')
end if
c
c %-------------------------------------------%
c | Print additional convergence information. |
c %-------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV1'
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program pcndrv1. |
c %----------------------------%
c
9000 continue
c
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector subroutine
c
c The matrix used is the convection-diffusion operator
c discretized using centered difference.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c derived from the standard central difference discretization
c of the convection-diffusion operator (Laplacian u) + rho*(du/dx)
c with zero boundary condition.
c
c The subroutine TV is called to computed y<---T*x.
c
c----------------------------------------------------------------------------
subroutine av (comm, nloc, nx, mv_buf, v, w )
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, cgesd2d, cgerv2d
c
integer nloc, nx, np, j, lo, next, prev
Complex
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = (1.0, 0.0))
external caxpy, tv
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call caxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call caxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call caxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
c
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call caxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call cgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call cgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call caxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call cgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call cgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call caxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Complex
& x(nx), y(nx), h, dd, dl, du
c
Complex
& one, rho
parameter (one = (1.0, 0.0), rho = (100.0, 0.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 / cmplx(nx+1)
dd = (4.0, 0.0)
dl = -one - (0.5, 0.0)*rho*h
du = -one + (0.5, 0.0)*rho*h
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pdsdrv1.f 0000644 0001750 0001750 00000042306 12277373057 015203 0000000 0000000 program pdsdrv1
c
c Message Passing Layer: BLACS
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x.
c ... Use mode 1 of DSAUPD.
c
c\BeginLib
c
c\Routines called:
c pdsaupd Parallel ARPACK reverse communication interface routine.
c pdseupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c pdnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c daxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sdrv1.F SID: 2.2
c
c FILE: sdrv1.F SID: 1.4 DATE OF SID: 3/19/97 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=10, maxncv=25,
& ldv=maxnloc )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Double precision
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxnloc), d(maxncv,2), resid(maxnloc),
& ax(maxnloc)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Double precision
& tol, sigma
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Double precision
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Double precision
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Double precision
& pdnorm2
external pdnorm2, daxpy
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
msaupd = 1
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _SDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in PSSAUPD 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 PSSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of PSSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in PSSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSSAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pdsaupd ( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSSAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in PSSAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call pdseupd ( comm, rvec, 'All', select,
& d, v, ldv, sigma,
& bmat, nloc, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSSEUPD.|
c %------------------------------------%
c
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call daxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = pdnorm2( comm, nloc, ax, 1 )
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call pdmout(comm, 6, nconv, 2, d, maxncv, -6,
& 'Ritz values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_SDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
endif
c
end if
c
c %---------------------------%
c | Done with program pdsdrv1.|
c %---------------------------%
c
9000 continue
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c ------------------------------------------------------------------
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c-------------------------------------------------------------------
c
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, DGESD2D, DGERV2D
integer nloc, nx, np, j, lo, next, prev
Double precision
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external daxpy
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call daxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
if ( np .gt. 2) then
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call daxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
end if
c
if ( np .gt. 1) then
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call daxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
end if
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call dgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call dgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call daxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call dgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call dgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call daxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Double precision
& x(nx), y(nx), dd, dl, du
c
Double precision
& one
parameter (one = 1.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
c
dd = 4.0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/psndrv3.f 0000644 0001750 0001750 00000051725 12277373057 015224 0000000 0000000 program psndrv3
c
c Message Passing Layer: BLACS
c
c Simple program to illustrate the idea of reverse communication
c in inverse mode for a generalized nonsymmetric eigenvalue problem.
c
c We implement example three of ex-nonsym.doc in DOCUMENTS directory
c
c\Example-3
c ... Suppose we want to solve A*x = lambda*B*x in inverse mode,
c where A is derived from the 1-dimensional convection-diffusion
c operator on the interval [0,1] with zero boundary condition,
c and M is the tridiagonal matrix with 4 on the diagonal and 1
c on the subdiagonals.
c ... So OP = inv[M]*A and B = M.
c ... Use mode 2 of PSNAUPD.
c
c\BeginLib
c
c\Routines called:
c psnaupd Parallel ARPACK reverse communication interface routine.
c psneupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c spttrf LAPACK symmetric positive definite tridiagonal factorization
c routine.
c spttrs LAPACK symmetric positive definite tridiagonal solve routine.
c slapy2 LAPACK routine to compute sqrt(x**2+y**2) carefully.
c saxpy Level 1 BLAS that computes y <- alpha*x+y.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c av Parallel Matrix vector multiplication routine that computes A*x.
c mv Matrix vector multiplication routine that computes M*x.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: ndrv3.F SID: 2.2
c
c\SCCS Information:
c FILE: ndrv3.F SID: 1.2 DATE OF SID: 09/14/98 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c--------------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxn, maxnev, maxncv, ldv
parameter (maxn=256, maxnev=10, maxncv=25,
& ldv=maxn )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
integer iparam(11), ipntr(14)
logical select(maxncv)
Real
& ax(maxn), mx(maxn), d(maxncv, 3), resid(maxn),
& v(ldv,maxncv), workd(3*maxn),
& workev(3*maxncv),
& workl(3*maxncv*maxncv+6*maxncv),
& md(maxn), me(maxn-1), temp(maxn), temp_buf(maxn)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nconv, maxitr, ishfts, mode, blk
Real
& tol, sigmar, sigmai
logical first, rvec
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero, one
parameter (zero = 0.0, one = 1.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
Real
& psnorm2, slapy2
external saxpy, psnorm2, spttrf, spttrs, slapy2
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
mnaupd = 1
c
c %----------------------------------------------------%
c | The number N is the dimension of the matrix. A |
c | generalized eigenvalue problem is solved (BMAT = |
c | 'G'). NEV is the number of eigenvalues to be |
c | approximated. The user can modify NEV, NCV, WHICH |
c | to solve problems of different sizes, and to get |
c | different parts of the spectrum. However, The |
c | following conditions must be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
n = 100
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (n / nprocs )
blk = nloc
if ( mod(n, nprocs) .gt. 0 ) then
if ( myprow .eq. nprow-1 ) nloc = nloc + mod(n, nprocs)
* if ( mod(n, nprocs) .gt. myprow ) nloc = nloc + 1
endif
c
if ( nloc .gt. maxn ) then
print *, ' ERROR with _NDRV3: NLOC is greater than MAXN '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _NDRV3: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _NDRV3: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'G'
which = 'LM'
c
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 | spttrf. |
c %-----------------------------------------------------%
c
do 20 j = 1, n-1
md(j) = 4.0
me(j) = one
20 continue
md(n) = 4.0*one
c
call spttrf(n, md, me, ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrf. '
print*, ' '
go to 9000
end if
c
c %-----------------------------------------------------%
c | The work array WORKL is used in SNAUPD 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 SNAUPD to start the Arnoldi iteration. |
c %-----------------------------------------------------%
c
lworkl = 3*ncv**2+6*ncv
tol = 0.0
ido = 0
info = 0
c
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 SNAUPD is used |
c | (IPARAM(7) = 2). All these options can be |
c | changed by the user. For details, see the |
c | documentation in SNAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 2
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine SNAUPD and take |
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call psnaupd( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %----------------------------------------%
c | Perform y <--- OP*x = inv[M]*A*x |
c | The user should supply his/her own |
c | matrix vector routine and a linear |
c | system solver. The matrix-vector |
c | subroutine should take workd(ipntr(1)) |
c | as input, and the final result should |
c | be returned to workd(ipntr(2)). |
c %----------------------------------------%
c
call av (comm, nloc, n, workd(ipntr(1)), workd(ipntr(2)))
c======== Hack for Linear system ======= ccc
call sscal(n, zero, temp, 1)
do 15 j=1,nloc
temp(myprow*blk + j) = workd(ipntr(2) + j - 1)
15 continue
call sgsum2d( comm, 'All', ' ', n, 1, temp, n, -1, -1 )
call spttrs(n, 1, md, me, temp, n,
& ierr)
if ( ierr .ne. 0 ) then
print*, ' '
print*, ' ERROR with _pttrs. '
print*, ' '
go to 9000
end if
do 16 j=1,nloc
workd(ipntr(2) + j - 1 ) = temp(myprow*blk + j)
16 continue
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
else if ( ido .eq. 2) then
c
c %-------------------------------------%
c | Perform y <--- M*x |
c | The matrix vector multiplication |
c | routine should take workd(ipntr(1)) |
c | as input and return the result to |
c | workd(ipntr(2)). |
c %-------------------------------------%
c
call mv (comm, nloc, workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call SNAUPD again. |
c %-----------------------------------------%
c
go to 10
c
end if
c
c
c %-----------------------------------------%
c | Either we have convergence, or there is |
c | an error. |
c %-----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %---------------------------%
c | Error message. Check the |
c | documentation in PSNAUPD. |
c %---------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _naupd, info = ', info
print *, ' Check the documentation of _naupd.'
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using SNEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
call psneupd ( comm, rvec, 'A', select, d, d(1,2), v, ldv,
& sigmar, sigmai, workev, bmat, nloc, which, nev, tol,
& resid, ncv, v, ldv, iparam, ipntr, workd,
& workl, lworkl, ierr )
c
c %-----------------------------------------------%
c | The real part of the eigenvalue is returned |
c | in the first column of the two dimensional |
c | array D, and the IMAGINARY part is returned |
c | in the second column of D. The corresponding |
c | eigenvectors are returned in the first NEV |
c | columns of the two dimensional array V if |
c | requested. Otherwise, an orthogonal basis |
c | for the invariant subspace corresponding to |
c | the eigenvalues in D is returned in V. |
c %-----------------------------------------------%
c
if ( ierr .ne. 0 ) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of SNEUPD. |
c %------------------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _neupd, info = ', ierr
print *, ' Check the documentation of _neupd'
print *, ' '
endif
c
else
c
first = .true.
nconv = iparam(5)
do 30 j=1, iparam(5)
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*M*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
if (d(j,2) .eq. zero) then
c
c %--------------------%
c | Ritz value is real |
c %--------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
d(j,3) = psnorm2(comm, nloc, ax, 1)
c
else if (first) then
c
c %------------------------%
c | Ritz value is complex |
c | Residual of one Ritz |
c | value of the conjugate |
c | pair is computed. |
c %------------------------%
c
call av(comm, nloc, n, v(1,j), ax)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j+1), mx)
call saxpy(nloc, d(j,2), mx, 1, ax, 1)
d(j,3) = psnorm2(comm, nloc, ax, 1)**2
call av(comm, nloc, n, v(1,j+1), ax)
call mv(comm, nloc, v(1,j+1), mx)
call saxpy(nloc, -d(j,1), mx, 1, ax, 1)
call mv(comm, nloc, v(1,j), mx)
call saxpy(nloc, -d(j,2), mx, 1, ax, 1)
d(j,3) = slapy2( d(j,3), psnorm2(comm,nloc,ax,1) )
d(j+1,3) = d(j,3)
first = .false.
else
first = .true.
end if
c
30 continue
c
c %-----------------------------%
c | Display computed residuals. |
c %-----------------------------%
c
call psmout(comm, 6, nconv, 3, d, maxncv, -6,
& 'Ritz values (Real,Imag) and direct residuals')
c
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_NDRV3 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
c
endif
end if
c
c %----------------------------%
c | Done with program psndrv3. |
c %----------------------------%
c
9000 continue
c
c %-------------------------%
c | Release resources BLACS |
c %-------------------------%
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c==========================================================================
c
c parallel matrix vector multiplication subroutine
c
c Compute the matrix vector multiplication y<---A*x
c where A is a n by n nonsymmetric tridiagonal matrix derived
c from the central difference discretization of the 1-dimensional
c convection diffusion operator on the interval [0,1] with
c zero Dirichlet boundary condition.
c
subroutine av (comm, nloc, n, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, sgesd2d, sgerv2d
c
integer nloc, n, j, next, prev
Real
& v(nloc), w(nloc), one, two, dd, dl, du,
& s, h, rho, mv_buf
parameter ( rho = 10.0, one = 1.0,
& two = 2.0)
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
h = one / real(n+1)
s = rho*h / two
dd = two
dl = -one - s
du = -one + s
c
w(1) = dd*v(1) + du*v(2)
do 10 j = 2,nloc-1
w(j) = dl*v(j-1) + dd*v(j) + du*v(j+1)
10 continue
w(nloc) = dl*v(nloc-1) + dd*v(nloc)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call sgesd2d( comm, 1, 1, v(nloc), 1, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call sgerv2d( comm, 1, 1, mv_buf, 1, prev, mypcol )
w(1) = w(1) + dl*mv_buf
endif
c
if ( myprow .gt. 0 ) then
call sgesd2d( comm, 1, 1, v(1), 1, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call sgerv2d( comm, 1, 1, mv_buf, 1, next, mypcol )
w(nloc) = w(nloc) + du*mv_buf
endif
c
return
end
c------------------------------------------------------------------------
c
c Compute the matrix vector multiplication y<---M*x
c where M is a n by n tridiagonal matrix with 4 on the
c diagonal, 1 on the subdiagonal and the superdiagonal.
c
subroutine mv (comm, nloc, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, sgesd2d, sgerv2d
c
integer nloc, j, next, prev
Real
& v(nloc), w(nloc), one, four, mv_buf
parameter ( one = 1.0, four = 4.0)
c
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
w(1) = four*v(1) + one*v(2)
do 10 j = 2,nloc-1
w(j) = one*v(j-1) + four*v(j) + one*v(j+1)
10 continue
w(nloc) = one*v(nloc-1) + four*v(nloc)
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call sgesd2d( comm, 1, 1, v(nloc), 1, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call sgerv2d( comm, 1, 1, mv_buf, 1, prev, mypcol )
w(1) = w(1) + mv_buf
endif
c
if ( myprow .gt. 0 ) then
call sgesd2d( comm, 1, 1, v(1), 1, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call sgerv2d( comm, 1, 1, mv_buf, 1, next, mypcol )
w(nloc) = w(nloc) + mv_buf
endif
c
return
end
c------------------------------------------------------------
subroutine mv2 (comm, n, v, w)
integer n, j, comm
Real
& v(n), w(n)
do 10 j=1,n
w(j) = v(j)
10 continue
c
return
end
arpack-ng-3.1.5/PARPACK/EXAMPLES/BLACS/pssdrv1.f 0000644 0001750 0001750 00000042146 12277373057 015224 0000000 0000000 program pssdrv1
c
c Message Passing Layer: BLACS
c
c Simple program to illustrate the idea of reverse communication
c in regular mode for a standard symmetric eigenvalue problem.
c
c We implement example one of ex-sym.doc in SRC directory
c
c\Example-1
c ... Suppose we want to solve A*x = lambda*x in regular mode,
c where A is derived from the central difference discretization
c of the 2-dimensional Laplacian on the unit square with
c zero Dirichlet boundary condition.
c ... OP = A and B = I.
c ... Assume "call av (n,x,y)" computes y = A*x.
c ... Use mode 1 of SSAUPD.
c
c\BeginLib
c
c\Routines called:
c pssaupd Parallel ARPACK reverse communication interface routine.
c psseupd Parallel ARPACK routine that returns Ritz values and (optionally)
c Ritz vectors.
c psnorm2 Parallel version of Level 1 BLAS that computes the norm of a vector.
c saxpy 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
c av.
c
c\Author
c Richard Lehoucq
c Danny Sorensen
c Chao Yang
c Dept. of Computational &
c Applied Mathematics
c Rice University
c Houston, Texas
c
c\Parallel Modifications
c Kristi Maschhoff
c
c\Revision history:
c Starting Point: Serial Code FILE: sdrv1.F SID: 2.2
c
c FILE: sdrv1.F SID: 1.4 DATE OF SID: 3/19/97 RELEASE: 1
c
c\Remarks
c 1. None
c
c\EndLib
c
c-----------------------------------------------------------------------
c
include 'debug.h'
include 'stat.h'
c %-----------------%
c | BLACS INTERFACE |
c %-----------------%
c
integer comm, iam, nprocs, nloc,
& nprow, npcol, myprow, mypcol
c
external BLACS_PINFO, BLACS_SETUP, BLACS_GET,
& BLACS_GRIDINIT, BLACS_GRIDINFO
c
c %-----------------------------%
c | Define leading dimensions |
c | for all arrays. |
c | MAXN: Maximum dimension |
c | of the A allowed. |
c | MAXNEV: Maximum NEV allowed |
c | MAXNCV: Maximum NCV allowed |
c %-----------------------------%
c
integer maxnloc, maxnev, maxncv, ldv
parameter (maxnloc=256, maxnev=10, maxncv=25,
& ldv=maxnloc )
c
c %--------------%
c | Local Arrays |
c %--------------%
c
Real
& v(ldv,maxncv), workl(maxncv*(maxncv+8)),
& workd(3*maxnloc), d(maxncv,2), resid(maxnloc),
& ax(maxnloc)
logical select(maxncv)
integer iparam(11), ipntr(11)
c
c %---------------%
c | Local Scalars |
c %---------------%
c
character bmat*1, which*2
integer ido, n, nev, ncv, lworkl, info, ierr, j,
& nx, nconv, maxitr, mode, ishfts
logical rvec
Real
& tol, sigma
c
c %----------------------------------------------%
c | Local Buffers needed for BLACS communication |
c %----------------------------------------------%
c
Real
& mv_buf(maxnloc)
c
c %------------%
c | Parameters |
c %------------%
c
Real
& zero
parameter (zero = 0.0)
c
c %-----------------------------%
c | BLAS & LAPACK routines used |
c %-----------------------------%
c
Real
& psnorm2
external psnorm2, saxpy
c
c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic abs
c
c %-----------------------%
c | Executable Statements |
c %-----------------------%
c
call BLACS_PINFO( iam, nprocs )
c
c If in PVM, create virtual machine if it doesn't exist
c
if (nprocs .lt. 1) then
if (iam .eq. 0) then
write(*,1000)
read(*, 2000) nprocs
endif
call BLACS_SETUP( iam, nprocs )
endif
c
1000 format('How many processes in machine?')
2000 format(I3)
c
c Set up processors in 1D Grid
c
nprow = nprocs
npcol = 1
c
c Get default system context, and define grid
c
call BLACS_GET( 0, 0, comm )
call BLACS_GRIDINIT( comm, 'Row', nprow, npcol )
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
c If I'm not in grid, go to end of program
c
if ( (myprow .ge. nprow) .or. (mypcol .ge. npcol) ) goto 9000
c
ndigit = -3
logfil = 6
msaupd = 1
c
c %----------------------------------------------------%
c | The number NX is the number of interior points |
c | in the discretization of the 2-dimensional |
c | Laplacian on the unit square with zero Dirichlet |
c | boundary condition. The number N(=NX*NX) is the |
c | dimension of the matrix. A standard eigenvalue |
c | problem is solved (BMAT = 'I'). NEV is the number |
c | of eigenvalues to be approximated. The user can |
c | modify NEV, NCV, WHICH to solve problems of |
c | different sizes, and to get different parts of the |
c | spectrum. However, The following conditions must |
c | be satisfied: |
c | N <= MAXN, |
c | NEV <= MAXNEV, |
c | NEV + 2 <= NCV <= MAXNCV |
c %----------------------------------------------------%
c
nx = 10
n = nx*nx
nev = 4
ncv = 20
c
c %--------------------------------------%
c | Set up distribution of data to nodes |
c %--------------------------------------%
c
nloc = (nx / nprocs)*nx
if ( mod(nx, nprocs) .gt. myprow ) nloc = nloc + nx
c
if ( nloc .gt. maxnloc ) then
print *, ' ERROR with _SDRV1: NLOC is greater than MAXNLOC '
go to 9000
else if ( nev .gt. maxnev ) then
print *, ' ERROR with _SDRV1: NEV is greater than MAXNEV '
go to 9000
else if ( ncv .gt. maxncv ) then
print *, ' ERROR with _SDRV1: NCV is greater than MAXNCV '
go to 9000
end if
bmat = 'I'
which = 'SM'
c
c %--------------------------------------------------%
c | The work array WORKL is used in PSSAUPD 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 PSSAUPD to start the Arnoldi |
c | iteration. |
c %--------------------------------------------------%
c
lworkl = ncv*(ncv+8)
tol = zero
info = 0
ido = 0
c
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 1 of PSSAUPD is used |
c | (IPARAM(7) = 1). All these options may be |
c | changed by the user. For details, see the |
c | documentation in PSSAUPD. |
c %---------------------------------------------------%
c
ishfts = 1
maxitr = 300
mode = 1
c
iparam(1) = ishfts
iparam(3) = maxitr
iparam(7) = mode
c
c %-------------------------------------------%
c | M A I N L O O P (Reverse communication) |
c %-------------------------------------------%
c
10 continue
c
c %---------------------------------------------%
c | Repeatedly call the routine PSSAUPD and take|
c | actions indicated by parameter IDO until |
c | either convergence is indicated or maxitr |
c | has been exceeded. |
c %---------------------------------------------%
c
call pssaupd ( comm, ido, bmat, nloc, which, nev, tol, resid,
& ncv, v, ldv, iparam, ipntr, workd, workl,
& lworkl, info )
c
if (ido .eq. -1 .or. ido .eq. 1) then
c
c %--------------------------------------%
c | Perform matrix vector multiplication |
c | y <--- OP*x |
c | The user should supply his/her own |
c | matrix vector multiplication routine |
c | here that takes workd(ipntr(1)) as |
c | the input, and return the result to |
c | workd(ipntr(2)). |
c %--------------------------------------%
c
call av ( comm, nloc, nx, mv_buf,
& workd(ipntr(1)), workd(ipntr(2)))
c
c %-----------------------------------------%
c | L O O P B A C K to call PSSAUPD again.|
c %-----------------------------------------%
c
go to 10
c
end if
c
c %----------------------------------------%
c | Either we have convergence or there is |
c | an error. |
c %----------------------------------------%
c
if ( info .lt. 0 ) then
c
c %--------------------------%
c | Error message. Check the |
c | documentation in PSSAUPD.|
c %--------------------------%
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _saupd, info = ', info
print *, ' Check documentation in _saupd '
print *, ' '
endif
c
else
c
c %-------------------------------------------%
c | No fatal errors occurred. |
c | Post-Process using PSSEUPD. |
c | |
c | Computed eigenvalues may be extracted. |
c | |
c | Eigenvectors may also be computed now if |
c | desired. (indicated by rvec = .true.) |
c %-------------------------------------------%
c
rvec = .true.
c
call psseupd ( comm, rvec, 'All', select,
& d, v, ldv, sigma,
& bmat, nloc, which, nev, tol, resid, ncv, v, ldv,
& iparam, ipntr, workd, workl, lworkl, ierr )
c %----------------------------------------------%
c | Eigenvalues are returned in the first column |
c | of the two dimensional array D and the |
c | corresponding eigenvectors are returned in |
c | the first NEV columns of the two dimensional |
c | array V if requested. Otherwise, an |
c | orthogonal basis for the invariant subspace |
c | corresponding to the eigenvalues in D is |
c | returned in V. |
c %----------------------------------------------%
c
if ( ierr .ne. 0) then
c
c %------------------------------------%
c | Error condition: |
c | Check the documentation of PSSEUPD.|
c %------------------------------------%
c
c
if ( myprow .eq. 0 ) then
print *, ' '
print *, ' Error with _seupd, info = ', ierr
print *, ' Check the documentation of _seupd. '
print *, ' '
endif
c
else
c
nconv = iparam(5)
do 20 j=1, nconv
c
c %---------------------------%
c | Compute the residual norm |
c | |
c | || A*x - lambda*x || |
c | |
c | for the NCONV accurately |
c | computed eigenvalues and |
c | eigenvectors. (iparam(5) |
c | indicates how many are |
c | accurate to the requested |
c | tolerance) |
c %---------------------------%
c
call av(comm, nloc, nx, mv_buf, v(1,j), ax)
call saxpy(nloc, -d(j,1), v(1,j), 1, ax, 1)
d(j,2) = psnorm2( comm, nloc, ax, 1 )
c
20 continue
c
c %-------------------------------%
c | Display computed residuals |
c %-------------------------------%
c
call psmout(comm, 6, nconv, 2, d, maxncv, -6,
& 'Ritz values and direct residuals')
end if
c
c %------------------------------------------%
c | Print additional convergence information |
c %------------------------------------------%
c
if (myprow .eq. 0)then
if ( info .eq. 1) then
print *, ' '
print *, ' Maximum number of iterations reached.'
print *, ' '
else if ( info .eq. 3) then
print *, ' '
print *, ' No shifts could be applied during implicit
& Arnoldi update, try increasing NCV.'
print *, ' '
end if
c
print *, ' '
print *, '_SDRV1 '
print *, '====== '
print *, ' '
print *, ' Size of the matrix is ', n
print *, ' The number of processors is ', nprocs
print *, ' The number of Ritz values requested is ', nev
print *, ' The number of Arnoldi vectors generated',
& ' (NCV) is ', ncv
print *, ' What portion of the spectrum: ', which
print *, ' The number of converged Ritz values is ',
& nconv
print *, ' The number of Implicit Arnoldi update',
& ' iterations taken is ', iparam(3)
print *, ' The number of OP*x is ', iparam(9)
print *, ' The convergence criterion is ', tol
print *, ' '
endif
c
end if
c
c %---------------------------%
c | Done with program pssdrv1.|
c %---------------------------%
c
9000 continue
c
call BLACS_GRIDEXIT ( comm )
call BLACS_EXIT(0)
c
end
c
c ------------------------------------------------------------------
c parallel matrix vector subroutine
c
c The matrix used is the 2 dimensional discrete Laplacian on unit
c square with zero Dirichlet boundary condition.
c
c Computes w <--- OP*v, where OP is the nx*nx by nx*nx block
c tridiagonal matrix
c
c | T -I |
c |-I T -I |
c OP = | -I T |
c | ... -I|
c | -I T|
c
c The subroutine TV is called to computed y<---T*x.
c-------------------------------------------------------------------
c
subroutine av (comm, nloc, nx, mv_buf, v, w)
c
c .. BLACS Declarations ...
integer comm, nprow, npcol, myprow, mypcol
external BLACS_GRIDINFO, SGESD2D, SGERV2D
integer nloc, nx, np, j, lo, next, prev
Real
& v(nloc), w(nloc), mv_buf(nx), one
parameter (one = 1.0 )
external saxpy
call BLACS_GRIDINFO( comm, nprow, npcol, myprow, mypcol )
c
np = nloc/nx
call tv(nx,v(1),w(1))
call saxpy(nx, -one, v(nx+1), 1, w(1), 1)
c
if ( np .gt. 2) then
do 10 j = 2, np-1
lo = (j-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
call saxpy(nx, -one, v(lo+nx+1), 1, w(lo+1), 1)
10 continue
end if
c
if ( np .gt. 1) then
lo = (np-1)*nx
call tv(nx, v(lo+1), w(lo+1))
call saxpy(nx, -one, v(lo-nx+1), 1, w(lo+1), 1)
end if
c
next = myprow + 1
prev = myprow - 1
if ( myprow .lt. nprow-1 ) then
call sgesd2d( comm, nx, 1, v((np-1)*nx+1), nx, next, mypcol)
endif
if ( myprow .gt. 0 ) then
call sgerv2d( comm, nx, 1, mv_buf, nx, prev, mypcol )
call saxpy( nx, -one, mv_buf, 1, w(1), 1 )
endif
c
if ( myprow .gt. 0 ) then
call sgesd2d( comm, nx, 1, v(1), nx, prev, mypcol)
endif
if ( myprow .lt. nprow-1 ) then
call sgerv2d( comm, nx, 1, mv_buf, nx, next, mypcol )
call saxpy( nx, -one, mv_buf, 1, w(lo+1), 1 )
endif
c
return
end
c=========================================================================
subroutine tv (nx, x, y)
c
integer nx, j
Real
& x(nx), y(nx), dd, dl, du
c
Real
& one
parameter (one = 1.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
c
dd = 4.0
dl = -one
du = -one
c
y(1) = dd*x(1) + du*x(2)
do 10 j = 2,nx-1
y(j) = dl*x(j-1) + dd*x(j) + du*x(j+1)
10 continue
y(nx) = dl*x(nx-1) + dd*x(nx)
return
end
arpack-ng-3.1.5/PARPACK/UTIL/ 0000755 0001750 0001750 00000000000 12277671743 012242 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/UTIL/Makefile.am 0000644 0001750 0001750 00000000025 12277373057 014210 0000000 0000000 SUBDIRS = MPI BLACS
arpack-ng-3.1.5/PARPACK/UTIL/Makefile.in 0000644 0001750 0001750 00000043703 12277667632 014240 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/UTIL
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
SOURCES =
DIST_SOURCES =
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
distdir
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = MPI BLACS
all: all-recursive
.SUFFIXES:
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/UTIL/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/UTIL/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile
installdirs: installdirs-recursive
installdirs-am:
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libtool mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-generic distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am:
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am:
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-generic mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am:
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \
check-am clean clean-generic clean-libtool cscopelist-am ctags \
ctags-am distclean distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am install-man \
install-pdf install-pdf-am install-ps install-ps-am \
install-strip installcheck installcheck-am installdirs \
installdirs-am maintainer-clean maintainer-clean-generic \
mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \
ps ps-am tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/UTIL/MPI/ 0000755 0001750 0001750 00000000000 12277671743 012667 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/UTIL/MPI/pivout.f 0000644 0001750 0001750 00000007526 12277373057 014313 0000000 0000000 * Routine: PIVOUT - Parallel version of ARPACK UTILITY ROUTINE IVOUT
*
* Purpose: Integer vector output routine.
*
* Usage: CALL PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* N - Length of array IX. (Input)
* IX - Integer array to be printed. (Input)
* IFMT - Format to be used in printing array IX. (Input)
* IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: ivout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT)
*
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER IX(*), N, IDIGIT, LOUT
CHARACTER IFMT*(*)
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN ( LEN ( IFMT ), 80 )
DO 1 I = 1, LLL
LINE(I:I) = '-'
1 CONTINUE
*
DO 2 I = LLL+1, 80
LINE(I:I) = ' '
2 CONTINUE
*
WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
2000 FORMAT ( /1X, A /1X, A )
*
IF (N .LE. 0) RETURN
NDIGIT = IDIGIT
IF (IDIGIT .EQ. 0) NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF (IDIGIT .LT. 0) THEN
*
NDIGIT = -IDIGIT
IF (NDIGIT .LE. 4) THEN
DO 10 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
10 CONTINUE
*
ELSE IF (NDIGIT .LE. 6) THEN
DO 30 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
30 CONTINUE
*
ELSE IF (NDIGIT .LE. 10) THEN
DO 50 K1 = 1, N, 5
K2 = MIN0(N,K1+4)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
50 CONTINUE
*
ELSE
DO 70 K1 = 1, N, 3
K2 = MIN0(N,K1+2)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
70 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
*
IF (NDIGIT .LE. 4) THEN
DO 90 K1 = 1, N, 20
K2 = MIN0(N,K1+19)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
90 CONTINUE
*
ELSE IF (NDIGIT .LE. 6) THEN
DO 110 K1 = 1, N, 15
K2 = MIN0(N,K1+14)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
110 CONTINUE
*
ELSE IF (NDIGIT .LE. 10) THEN
DO 130 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
130 CONTINUE
*
ELSE
DO 150 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
150 CONTINUE
END IF
END IF
WRITE (LOUT,1004)
ENDIF
*
1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
1004 FORMAT(1X,' ')
*
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/Makefile.am 0000644 0001750 0001750 00000000264 12277373057 014642 0000000 0000000 F77 = $(MPIF77)
noinst_LTLIBRARIES = libparpackutilmpi.la
libparpackutilmpi_la_SOURCES = \
pivout.f psvout.f psmout.f pdvout.f \
pdmout.f pcvout.f pcmout.f pzvout.f pzmout.f
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pdvout.f 0000644 0001750 0001750 00000010576 12277373057 014305 0000000 0000000 * Routine: PDVOUT - Parallel Version of ARPACK utility routine DVOUT
*
* Purpose: Double precision vector output routine.
*
* Usage: CALL PDVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* N - Length of array SX. (Input)
* SX - Double precision array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PDVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LOUT, N
* ..
* .. Array Arguments ..
Double precision
& SX( * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, K1, K2, LLL, NDIGIT
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9994 )
ENDIF
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pcmout.f 0000644 0001750 0001750 00000021723 12277373057 014267 0000000 0000000 *
* Routine: PCMOUT - Parallel Version of ARPACK utility routine CMOUT
*
* Purpose: Complex matrix output routine.
*
* Usage: CALL PCMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: mout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PCMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,
& ') '))
*
*
*
*
ENDIF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pzmout.f 0000644 0001750 0001750 00000021734 12277373057 014320 0000000 0000000 *
* Routine: PZMOUT - Parallel Version of ARPACK utility routine ZMOUT
*
* Purpose: Complex*16 matrix output routine.
*
* Usage: CALL PZMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex*16 M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: mout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PZMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex*16
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',D10.3,',',D10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D10.3,',',D10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D12.5,',',D12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D14.7,',',D14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D20.13,',',D20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,
& ') '))
*
*
*
*
ENDIF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/psvout.f 0000644 0001750 0001750 00000010532 12277373057 014314 0000000 0000000 * Routine: PSVOUT - Parallel Version of ARPACK utility routine SVOUT
*
* Purpose: Real vector output routine.
*
* Usage: CALL PSVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* N - Length of array SX. (Input)
* SX - Real array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PSVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LOUT, N
* ..
* .. Array Arguments ..
Real
& SX( * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, K1, K2, LLL, NDIGIT
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9994 )
ENDIF
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10E12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8E14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6E18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5E24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pzvout.f 0000644 0001750 0001750 00000020444 12277373057 014326 0000000 0000000 * Routine: PZVOUT - Parallel Version of ARPACK utility routine ZVOUT
*
* Purpose: Complex*16 vector output routine.
*
* Usage: CALL PZVOUT (COMM, LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* N - Length of array CX. (Input)
* CX - Complex*16 array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: vout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PZVOUT( COMM, LOUT, N, CX, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex*16
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
*
*
ENDIF
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',D10.3,',',D10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D10.3,',',D10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D12.5,',',D12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D14.7,',',D14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D20.13,',',D20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/Makefile.in 0000644 0001750 0001750 00000037567 12277667632 014700 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/UTIL/MPI
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libparpackutilmpi_la_LIBADD =
am_libparpackutilmpi_la_OBJECTS = pivout.lo psvout.lo psmout.lo \
pdvout.lo pdmout.lo pcvout.lo pcmout.lo pzvout.lo pzmout.lo
libparpackutilmpi_la_OBJECTS = $(am_libparpackutilmpi_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libparpackutilmpi_la_SOURCES)
DIST_SOURCES = $(libparpackutilmpi_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = $(MPIF77)
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libparpackutilmpi.la
libparpackutilmpi_la_SOURCES = \
pivout.f psvout.f psmout.f pdvout.f \
pdmout.f pcvout.f pcmout.f pzvout.f pzmout.f
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/UTIL/MPI/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/UTIL/MPI/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libparpackutilmpi.la: $(libparpackutilmpi_la_OBJECTS) $(libparpackutilmpi_la_DEPENDENCIES) $(EXTRA_libparpackutilmpi_la_DEPENDENCIES)
$(AM_V_F77LD)$(F77LINK) $(libparpackutilmpi_la_OBJECTS) $(libparpackutilmpi_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/UTIL/MPI/psmout.f 0000644 0001750 0001750 00000013601 12277373057 014303 0000000 0000000 * Routine: PSMOUT - Parallel Version of ARPACK utility routine SMOUT
*
* Purpose: Real matrix output routine.
*
* Usage: CALL PSMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Real M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: mout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PSMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LDA, LOUT, M, N
* ..
* .. Array Arguments ..
Real
& A( LDA, * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, J, K1, K2, LLL, NDIGIT
* ..
* .. Local Arrays ..
CHARACTER ICOL( 3 )
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Data statements ..
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10E12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8E14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6E18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5E22.13 )
9990 FORMAT( 1X, ' ' )
*
END IF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pdmout.f 0000644 0001750 0001750 00000013645 12277373057 014274 0000000 0000000 * Routine: PDMOUT - Parallel Version of ARPACK utility routine DMOUT
*
* Purpose: Double precision matrix output routine.
*
* Usage: CALL PDMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Double precision M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: mout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PDMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LDA, LOUT, M, N
* ..
* .. Array Arguments ..
Double precision
& A( LDA, * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, J, K1, K2, LLL, NDIGIT
* ..
* .. Local Arrays ..
CHARACTER ICOL( 3 )
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Data statements ..
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 )
9990 FORMAT( 1X, ' ' )
*
END IF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/MPI/pcvout.f 0000644 0001750 0001750 00000020433 12277373057 014275 0000000 0000000 * Routine: PCVOUT - Parallel Version of ARPACK utility routine CVOUT
*
* Purpose: Complex vector output routine.
*
* Usage: CALL PCVOUT (COMM, LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* COMM - MPI Communicator for the processor grid
* N - Length of array CX. (Input)
* CX - Complex array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: vout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PCVOUT( COMM, LOUT, N, CX, IDIGIT, IFMT )
* ...
include 'mpif.h'
*
* .. MPI VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, MYID, IERR
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
* Determine processor configuration
*
call MPI_COMM_RANK( comm, myid, ierr )
*
* .. Only Processor 0 will write to file LOUT ..
*
IF ( MYID .EQ. 0 ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
*
*
ENDIF
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',E10.3,',',E10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E10.3,',',E10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E12.5,',',E12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E14.7,',',E14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E20.13,',',E20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/ 0000755 0001750 0001750 00000000000 12277671743 013066 5 0000000 0000000 arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pivout.f 0000644 0001750 0001750 00000007702 12277373057 014506 0000000 0000000 * Routine: PIVOUT - Parallel version of ARPACK UTILITY ROUTINE IVOUT
*
* Purpose: Integer vector output routine.
*
* Usage: CALL PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* N - Length of array IX. (Input)
* IX - Integer array to be printed. (Input)
* IFMT - Format to be used in printing array IX. (Input)
* IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: ivout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PIVOUT (COMM, LOUT, N, IX, IDIGIT, IFMT)
*
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER IX(*), N, IDIGIT, LOUT
CHARACTER IFMT*(*)
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN ( LEN ( IFMT ), 80 )
DO 1 I = 1, LLL
LINE(I:I) = '-'
1 CONTINUE
*
DO 2 I = LLL+1, 80
LINE(I:I) = ' '
2 CONTINUE
*
WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
2000 FORMAT ( /1X, A /1X, A )
*
IF (N .LE. 0) RETURN
NDIGIT = IDIGIT
IF (IDIGIT .EQ. 0) NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF (IDIGIT .LT. 0) THEN
*
NDIGIT = -IDIGIT
IF (NDIGIT .LE. 4) THEN
DO 10 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
10 CONTINUE
*
ELSE IF (NDIGIT .LE. 6) THEN
DO 30 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
30 CONTINUE
*
ELSE IF (NDIGIT .LE. 10) THEN
DO 50 K1 = 1, N, 5
K2 = MIN0(N,K1+4)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
50 CONTINUE
*
ELSE
DO 70 K1 = 1, N, 3
K2 = MIN0(N,K1+2)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
70 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
*
IF (NDIGIT .LE. 4) THEN
DO 90 K1 = 1, N, 20
K2 = MIN0(N,K1+19)
WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
90 CONTINUE
*
ELSE IF (NDIGIT .LE. 6) THEN
DO 110 K1 = 1, N, 15
K2 = MIN0(N,K1+14)
WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
110 CONTINUE
*
ELSE IF (NDIGIT .LE. 10) THEN
DO 130 K1 = 1, N, 10
K2 = MIN0(N,K1+9)
WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
130 CONTINUE
*
ELSE
DO 150 K1 = 1, N, 7
K2 = MIN0(N,K1+6)
WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
150 CONTINUE
END IF
END IF
WRITE (LOUT,1004)
ENDIF
*
1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
1004 FORMAT(1X,' ')
*
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/Makefile.am 0000644 0001750 0001750 00000000252 12277373057 015036 0000000 0000000 noinst_LTLIBRARIES = libparpackutilblacs.la
libparpackutilblacs_la_SOURCES = \
pcmout.f pcvout.f pdmout.f pdvout.f \
pivout.f psmout.f psvout.f pzmout.f pzvout.f
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pdvout.f 0000644 0001750 0001750 00000010754 12277373057 014502 0000000 0000000 * Routine: PDVOUT - Parallel Version of ARPACK utility routine DVOUT
*
* Purpose: Double precision vector output routine.
*
* Usage: CALL PDVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* N - Length of array SX. (Input)
* SX - Double precision array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PDVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LOUT, N
* ..
* .. Array Arguments ..
Double precision
& SX( * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, K1, K2, LLL, NDIGIT
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9994 )
ENDIF
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pcmout.f 0000644 0001750 0001750 00000022101 12277373057 014455 0000000 0000000 *
* Routine: PCMOUT - Parallel Version of ARPACK utility routine CMOUT
*
* Purpose: Complex matrix output routine.
*
* Usage: CALL PCMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: mout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PCMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,
& ') '))
*
*
*
*
ENDIF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pzmout.f 0000644 0001750 0001750 00000022112 12277373057 014506 0000000 0000000 *
* Routine: PZMOUT - Parallel Version of ARPACK utility routine ZMOUT
*
* Purpose: Complex*16 matrix output routine.
*
* Usage: CALL PZMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Complex*16 M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: mout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PZMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
Complex*16
& A( LDA, * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, J, NDIGIT, K1, K2, LLL
CHARACTER*1 ICOL( 3 )
CHARACTER*80 LINE
* ...
* ... SPECIFICATIONS INTRINSICS
INTRINSIC MIN
*
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 )
END IF
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 )
END IF
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 80 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
IF (K1.NE.N) THEN
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 )
END IF
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N
WRITE( LOUT, 9995 ) ICOL, K1
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, A( I, K1 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.1) THEN
WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 )
ELSE IF ((K1+3-N).EQ.2) THEN
WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+3-N).EQ.3) THEN
WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 )
END IF
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 3
K2 = MIN0( N, K1+ 2)
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 )
END IF
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.8 ) THEN
DO 160 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.1) THEN
WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 )
ELSE IF ((K1+2-N).EQ.2) THEN
WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 )
END IF
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
IF ((K1+1).LE.N) THEN
WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 )
ELSE
WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 )
END IF
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) )
9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) )
9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) )
9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) )
*
*========================================================
* FORMAT FOR 72 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,')') )
9990 FORMAT( 1X, ' ' )
*
*
*========================================================
* FORMAT FOR 132 COLUMN
*========================================================
*
* DISPLAY 4 SIGNIFICANT DIGIT
*
9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',D10.3,',',D10.3,') ') )
9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D10.3,',',D10.3,') ') )
9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D10.3,',',D10.3,') ') )
9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGIT
*
9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D12.5,',',D12.5,') ') )
9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D12.5,',',D12.5,') ') )
9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGIT
*
9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',D14.7,',',D14.7,') ') )
9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D14.7,',',D14.7,') ') )
9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGIT
*
9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',D20.13,',',D20.13,
& ') '))
9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',D20.13,',',D20.13,
& ') '))
*
*
*
*
ENDIF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/psvout.f 0000644 0001750 0001750 00000010710 12277373057 014511 0000000 0000000 * Routine: PSVOUT - Parallel Version of ARPACK utility routine SVOUT
*
* Purpose: Real vector output routine.
*
* Usage: CALL PSVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* N - Length of array SX. (Input)
* SX - Real array to be printed. (Input)
* IFMT - Format to be used in printing array SX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PSVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LOUT, N
* ..
* .. Array Arguments ..
Real
& SX( * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, K1, K2, LLL, NDIGIT
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
40 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 50 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
50 CONTINUE
ELSE
DO 60 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
80 CONTINUE
ELSE IF( NDIGIT.LE.10 ) THEN
DO 90 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
100 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9994 )
ENDIF
RETURN
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10E12.3 )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8E14.5 )
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6E18.9 )
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5E24.13 )
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pzvout.f 0000644 0001750 0001750 00000020622 12277373057 014523 0000000 0000000 * Routine: PZVOUT - Parallel Version of ARPACK utility routine ZVOUT
*
* Purpose: Complex*16 vector output routine.
*
* Usage: CALL PZVOUT (COMM, LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* N - Length of array CX. (Input)
* CX - Complex*16 array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: vout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PZVOUT( COMM, LOUT, N, CX, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex*16
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
*
*
ENDIF
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',D10.3,',',D10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D10.3,',',D10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D10.3,',',D10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D10.3,',',D10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D12.5,',',D12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D12.5,',',D12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D12.5,',',D12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',D14.7,',',D14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D14.7,',',D14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D14.7,',',D14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',D20.13,',',D20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',D20.13,',',D20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/Makefile.in 0000644 0001750 0001750 00000037627 12277667632 015074 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK/UTIL/BLACS
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
LTLIBRARIES = $(noinst_LTLIBRARIES)
libparpackutilblacs_la_LIBADD =
am_libparpackutilblacs_la_OBJECTS = pcmout.lo pcvout.lo pdmout.lo \
pdvout.lo pivout.lo psmout.lo psvout.lo pzmout.lo pzvout.lo
libparpackutilblacs_la_OBJECTS = $(am_libparpackutilblacs_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libparpackutilblacs_la_SOURCES)
DIST_SOURCES = $(libparpackutilblacs_la_SOURCES)
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
F77 = @F77@
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
noinst_LTLIBRARIES = libparpackutilblacs.la
libparpackutilblacs_la_SOURCES = \
pcmout.f pcvout.f pdmout.f pdvout.f \
pivout.f psmout.f psvout.f pzmout.f pzvout.f
all: all-am
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/UTIL/BLACS/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/UTIL/BLACS/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
clean-noinstLTLIBRARIES:
-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
@list='$(noinst_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libparpackutilblacs.la: $(libparpackutilblacs_la_OBJECTS) $(libparpackutilblacs_la_DEPENDENCIES) $(EXTRA_libparpackutilblacs_la_DEPENDENCIES)
$(AM_V_F77LD)$(F77LINK) $(libparpackutilblacs_la_OBJECTS) $(libparpackutilblacs_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-am
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-am
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-am
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-am
all-am: Makefile $(LTLIBRARIES)
installdirs:
install: install-am
install-exec: install-exec-am
install-data: install-data-am
uninstall: uninstall-am
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-am
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-am
clean-am: clean-generic clean-libtool clean-noinstLTLIBRARIES \
mostlyclean-am
distclean: distclean-am
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-am
dvi-am:
html: html-am
html-am:
info: info-am
info-am:
install-data-am:
install-dvi: install-dvi-am
install-dvi-am:
install-exec-am:
install-html: install-html-am
install-html-am:
install-info: install-info-am
install-info-am:
install-man:
install-pdf: install-pdf-am
install-pdf-am:
install-ps: install-ps-am
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-am
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-am
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-am
pdf-am:
ps: ps-am
ps-am:
uninstall-am:
.MAKE: install-am install-strip
.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \
clean-libtool clean-noinstLTLIBRARIES cscopelist-am ctags \
ctags-am distclean distclean-compile distclean-generic \
distclean-libtool distclean-tags distdir dvi dvi-am html \
html-am info info-am install install-am install-data \
install-data-am install-dvi install-dvi-am install-exec \
install-exec-am install-html install-html-am install-info \
install-info-am install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/psmout.f 0000644 0001750 0001750 00000013757 12277373057 014516 0000000 0000000 * Routine: PSMOUT - Parallel Version of ARPACK utility routine SMOUT
*
* Purpose: Real matrix output routine.
*
* Usage: CALL PSMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Real M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: mout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PSMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LDA, LOUT, M, N
* ..
* .. Array Arguments ..
Real
& A( LDA, * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, J, K1, K2, LLL, NDIGIT
* ..
* .. Local Arrays ..
CHARACTER ICOL( 3 )
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Data statements ..
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10E12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8E14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6E18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5E22.13 )
9990 FORMAT( 1X, ' ' )
*
END IF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pdmout.f 0000644 0001750 0001750 00000014023 12277373057 014462 0000000 0000000 * Routine: PDMOUT - Parallel Version of ARPACK utility routine DMOUT
*
* Purpose: Double precision matrix output routine.
*
* Usage: CALL PDMOUT (COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Double precision M by N matrix to be printed. (Input)
* LDA - Leading dimension of A exactly as specified in the
* dimension statement of the calling program. (Input)
* IFMT - Format to be used in printing matrix A. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
*\SCCS Information:
* FILE: mout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PDMOUT( COMM, LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
* .. Scalar Arguments ..
CHARACTER*( * ) IFMT
INTEGER IDIGIT, LDA, LOUT, M, N
* ..
* .. Array Arguments ..
Double precision
& A( LDA, * )
* ..
* .. Local Scalars ..
CHARACTER*80 LINE
INTEGER I, J, K1, K2, LLL, NDIGIT
* ..
* .. Local Arrays ..
CHARACTER ICOL( 3 )
* ..
* .. Intrinsic Functions ..
INTRINSIC LEN, MIN, MIN0
* ..
* .. Data statements ..
DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
$ 'l' /
* ..
* .. Executable Statements ..
* ...
* ... FIRST EXECUTABLE STATEMENT
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A, / 1X, A )
*
IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 40 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, FMT = 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, FMT = 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, FMT = 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, FMT = 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, FMT = 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, FMT = 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, FMT = 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, FMT = 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, FMT = 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 10D12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 8D14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 6D18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P, 5D22.13 )
9990 FORMAT( 1X, ' ' )
*
END IF
RETURN
END
arpack-ng-3.1.5/PARPACK/UTIL/BLACS/pcvout.f 0000644 0001750 0001750 00000020611 12277373057 014472 0000000 0000000 * Routine: PCVOUT - Parallel Version of ARPACK utility routine CVOUT
*
* Purpose: Complex vector output routine.
*
* Usage: CALL PCVOUT (COMM, LOUT, N, CX, IDIGIT, IFMT)
*
* Arguments
* COMM - BLACS Communicator for the processor grid
* N - Length of array CX. (Input)
* CX - Complex array to be printed. (Input)
* IFMT - Format to be used in printing array CX. (Input)
* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
* If IDIGIT .LT. 0, printing is done with 72 columns.
* If IDIGIT .GT. 0, printing is done with 132 columns.
*
* FILE: vout.F SID: 1.1 DATE OF SID: 3/19/97 RELEASE: 1
*
*-----------------------------------------------------------------------
*
SUBROUTINE PCVOUT( COMM, LOUT, N, CX, IDIGIT, IFMT )
* ...
* .. BLACS VARIABLES AND FUNCTIONS ..
* .. Variable Declaration ..
integer COMM, NPROW, NPCOL, MYPROW, MYPCOL
*
* .. External Functions ..
external BLACS_GRIDINFO
*
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER N, IDIGIT, LOUT
Complex
& CX( * )
CHARACTER IFMT*( * )
* ...
* ... SPECIFICATIONS FOR LOCAL VARIABLES
INTEGER I, NDIGIT, K1, K2, LLL
CHARACTER*80 LINE
* ...
* ... FIRST EXECUTABLE STATEMENT
*
*
* Determine processor configuration
*
CALL BLACS_GRIDINFO( COMM, NPROW, NPCOL, MYPROW, MYPCOL )
*
* .. Only Processor (0,0) will write to file LOUT ..
*
IF ( (MYPROW .EQ. 0) .AND. (MYPCOL .EQ. 0) ) THEN
*
LLL = MIN( LEN( IFMT ), 80 )
DO 10 I = 1, LLL
LINE( I: I ) = '-'
10 CONTINUE
*
DO 20 I = LLL + 1, 80
LINE( I: I ) = ' '
20 CONTINUE
*
WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
9999 FORMAT( / 1X, A / 1X, A )
*
IF( N.LE.0 )
$ RETURN
NDIGIT = IDIGIT
IF( IDIGIT.EQ.0 )
$ NDIGIT = 4
*
*=======================================================================
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
*=======================================================================
*
IF( IDIGIT.LT.0 ) THEN
NDIGIT = -IDIGIT
IF( NDIGIT.LE.4 ) THEN
DO 30 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
30 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 40 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
40 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 50 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF (K1.NE.N) THEN
WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE
WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
50 CONTINUE
ELSE
DO 60 K1 = 1, N
WRITE( LOUT, 9968 )K1, K1, CX( I )
60 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 70 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
IF ((K1+3).LE.N) THEN
WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 2) THEN
WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+3-N) .EQ. 1) THEN
WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
70 CONTINUE
ELSE IF( NDIGIT.LE.6 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
80 CONTINUE
ELSE IF( NDIGIT.LE.8 ) THEN
DO 90 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 2) THEN
WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
90 CONTINUE
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
IF ((K1+2).LE.N) THEN
WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
$ I = K1, K2 )
ELSE IF ((K1+2-N) .EQ. 1) THEN
WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
$ I = K1, K2 )
END IF
100 CONTINUE
END IF
END IF
WRITE( LOUT, 9994 )
*
*
ENDIF
RETURN
*
*=======================================================================
* FORMAT FOR 72 COLUMNS
*=======================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*=========================================================================
* FORMAT FOR 132 COLUMNS
*=========================================================================
*
* DISPLAY 4 SIGNIFICANT DIGITS
*
9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,4('(',E10.3,',',E10.3,') ') )
9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E10.3,',',E10.3,') ') )
9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E10.3,',',E10.3,') ') )
9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E10.3,',',E10.3,') ') )
*
* DISPLAY 6 SIGNIFICANT DIGITS
*
9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E12.5,',',E12.5,') ') )
9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E12.5,',',E12.5,') ') )
9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E12.5,',',E12.5,') ') )
*
* DISPLAY 8 SIGNIFICANT DIGITS
*
9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,3('(',E14.7,',',E14.7,') ') )
9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E14.7,',',E14.7,') ') )
9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E14.7,',',E14.7,') ') )
*
* DISPLAY 13 SIGNIFICANT DIGITS
*
9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,2('(',E20.13,',',E20.13,') ') )
9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
$ 1P,1('(',E20.13,',',E20.13,') ') )
*
*
*
9994 FORMAT( 1X, ' ' )
END
arpack-ng-3.1.5/PARPACK/Makefile.am 0000644 0001750 0001750 00000001141 12277373057 013433 0000000 0000000 SUBDIRS = UTIL SRC . EXAMPLES/MPI EXAMPLES/BLACS
lib_LTLIBRARIES = libparpack.la
libparpack_la_SOURCES =
# Force libparpack to be linked with the MPI Fortran compiler.
# The file dummy.f does not need to exist in the source tree.
F77 = $(MPIF77)
nodist_EXTRA_libparpack_la_SOURCES = dummy.f
libparpack_la_LDFLAGS = -no-undefined -version-info 2:0
libparpack_la_LIBADD = \
$(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la \
$(top_builddir)/PARPACK/SRC/MPI/libparpacksrcmpi.la \
$(top_builddir)/PARPACK/UTIL/MPI/libparpackutilmpi.la \
$(BLAS_LIBS) $(LAPACK_LIBS) $(MPILIBS)
arpack-ng-3.1.5/PARPACK/Makefile.in 0000644 0001750 0001750 00000056274 12277667632 013472 0000000 0000000 # Makefile.in generated by automake 1.14.1 from Makefile.am.
# @configure_input@
# Copyright (C) 1994-2013 Free Software Foundation, Inc.
# This Makefile.in is free software; the Free Software Foundation
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
# PARTICULAR PURPOSE.
@SET_MAKE@
VPATH = @srcdir@
am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)'
am__make_running_with_option = \
case $${target_option-} in \
?) ;; \
*) echo "am__make_running_with_option: internal error: invalid" \
"target option '$${target_option-}' specified" >&2; \
exit 1;; \
esac; \
has_opt=no; \
sane_makeflags=$$MAKEFLAGS; \
if $(am__is_gnu_make); then \
sane_makeflags=$$MFLAGS; \
else \
case $$MAKEFLAGS in \
*\\[\ \ ]*) \
bs=\\; \
sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \
| sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \
esac; \
fi; \
skip_next=no; \
strip_trailopt () \
{ \
flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \
}; \
for flg in $$sane_makeflags; do \
test $$skip_next = yes && { skip_next=no; continue; }; \
case $$flg in \
*=*|--*) continue;; \
-*I) strip_trailopt 'I'; skip_next=yes;; \
-*I?*) strip_trailopt 'I';; \
-*O) strip_trailopt 'O'; skip_next=yes;; \
-*O?*) strip_trailopt 'O';; \
-*l) strip_trailopt 'l'; skip_next=yes;; \
-*l?*) strip_trailopt 'l';; \
-[dEDm]) skip_next=yes;; \
-[JT]) skip_next=yes;; \
esac; \
case $$flg in \
*$$target_option*) has_opt=yes; break;; \
esac; \
done; \
test $$has_opt = yes
am__make_dryrun = (target_option=n; $(am__make_running_with_option))
am__make_keepgoing = (target_option=k; $(am__make_running_with_option))
pkgdatadir = $(datadir)/@PACKAGE@
pkgincludedir = $(includedir)/@PACKAGE@
pkglibdir = $(libdir)/@PACKAGE@
pkglibexecdir = $(libexecdir)/@PACKAGE@
am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd
install_sh_DATA = $(install_sh) -c -m 644
install_sh_PROGRAM = $(install_sh) -c
install_sh_SCRIPT = $(install_sh) -c
INSTALL_HEADER = $(INSTALL_DATA)
transform = $(program_transform_name)
NORMAL_INSTALL = :
PRE_INSTALL = :
POST_INSTALL = :
NORMAL_UNINSTALL = :
PRE_UNINSTALL = :
POST_UNINSTALL = :
build_triplet = @build@
host_triplet = @host@
subdir = PARPACK
DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
am__aclocal_m4_deps = $(top_srcdir)/m4/ax_blas.m4 \
$(top_srcdir)/m4/ax_lapack.m4 $(top_srcdir)/m4/ax_mpi.m4 \
$(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \
$(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \
$(top_srcdir)/m4/lt~obsolete.m4 $(top_srcdir)/configure.ac
am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \
$(ACLOCAL_M4)
mkinstalldirs = $(install_sh) -d
CONFIG_CLEAN_FILES =
CONFIG_CLEAN_VPATH_FILES =
am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`;
am__vpath_adj = case $$p in \
$(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \
*) f=$$p;; \
esac;
am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`;
am__install_max = 40
am__nobase_strip_setup = \
srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'`
am__nobase_strip = \
for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||"
am__nobase_list = $(am__nobase_strip_setup); \
for p in $$list; do echo "$$p $$p"; done | \
sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \
$(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \
if (++n[$$2] == $(am__install_max)) \
{ print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \
END { for (dir in files) print dir, files[dir] }'
am__base_list = \
sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \
sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g'
am__uninstall_files_from_dir = { \
test -z "$$files" \
|| { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \
|| { echo " ( cd '$$dir' && rm -f" $$files ")"; \
$(am__cd) "$$dir" && rm -f $$files; }; \
}
am__installdirs = "$(DESTDIR)$(libdir)"
LTLIBRARIES = $(lib_LTLIBRARIES)
am__DEPENDENCIES_1 =
libparpack_la_DEPENDENCIES = $(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la \
$(top_builddir)/PARPACK/SRC/MPI/libparpacksrcmpi.la \
$(top_builddir)/PARPACK/UTIL/MPI/libparpackutilmpi.la \
$(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \
$(am__DEPENDENCIES_1)
am_libparpack_la_OBJECTS =
libparpack_la_OBJECTS = $(am_libparpack_la_OBJECTS)
AM_V_lt = $(am__v_lt_@AM_V@)
am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@)
am__v_lt_0 = --silent
am__v_lt_1 =
libparpack_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 \
$(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(F77LD) \
$(AM_FFLAGS) $(FFLAGS) $(libparpack_la_LDFLAGS) $(LDFLAGS) -o \
$@
AM_V_P = $(am__v_P_@AM_V@)
am__v_P_ = $(am__v_P_@AM_DEFAULT_V@)
am__v_P_0 = false
am__v_P_1 = :
AM_V_GEN = $(am__v_GEN_@AM_V@)
am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@)
am__v_GEN_0 = @echo " GEN " $@;
am__v_GEN_1 =
AM_V_at = $(am__v_at_@AM_V@)
am__v_at_ = $(am__v_at_@AM_DEFAULT_V@)
am__v_at_0 = @
am__v_at_1 =
DEFAULT_INCLUDES = -I.@am__isrc@
F77COMPILE = $(F77) $(AM_FFLAGS) $(FFLAGS)
LTF77COMPILE = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS)
AM_V_F77 = $(am__v_F77_@AM_V@)
am__v_F77_ = $(am__v_F77_@AM_DEFAULT_V@)
am__v_F77_0 = @echo " F77 " $@;
am__v_F77_1 =
F77LD = $(F77)
F77LINK = $(LIBTOOL) $(AM_V_lt) --tag=F77 $(AM_LIBTOOLFLAGS) \
$(LIBTOOLFLAGS) --mode=link $(F77LD) $(AM_FFLAGS) $(FFLAGS) \
$(AM_LDFLAGS) $(LDFLAGS) -o $@
AM_V_F77LD = $(am__v_F77LD_@AM_V@)
am__v_F77LD_ = $(am__v_F77LD_@AM_DEFAULT_V@)
am__v_F77LD_0 = @echo " F77LD " $@;
am__v_F77LD_1 =
SOURCES = $(libparpack_la_SOURCES) \
$(nodist_EXTRA_libparpack_la_SOURCES)
DIST_SOURCES = $(libparpack_la_SOURCES)
RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \
ctags-recursive dvi-recursive html-recursive info-recursive \
install-data-recursive install-dvi-recursive \
install-exec-recursive install-html-recursive \
install-info-recursive install-pdf-recursive \
install-ps-recursive install-recursive installcheck-recursive \
installdirs-recursive pdf-recursive ps-recursive \
tags-recursive uninstall-recursive
am__can_run_installinfo = \
case $$AM_UPDATE_INFO_DIR in \
n|no|NO) false;; \
*) (install-info --version) >/dev/null 2>&1;; \
esac
RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \
distclean-recursive maintainer-clean-recursive
am__recursive_targets = \
$(RECURSIVE_TARGETS) \
$(RECURSIVE_CLEAN_TARGETS) \
$(am__extra_recursive_targets)
AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \
distdir
am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP)
# Read a list of newline-separated strings from the standard input,
# and print each of them once, without duplicates. Input order is
# *not* preserved.
am__uniquify_input = $(AWK) '\
BEGIN { nonempty = 0; } \
{ items[$$0] = 1; nonempty = 1; } \
END { if (nonempty) { for (i in items) print i; }; } \
'
# Make sure the list of sources is unique. This is necessary because,
# e.g., the same source file might be shared among _SOURCES variables
# for different programs/libraries.
am__define_uniq_tagged_files = \
list='$(am__tagged_files)'; \
unique=`for i in $$list; do \
if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
done | $(am__uniquify_input)`
ETAGS = etags
CTAGS = ctags
DIST_SUBDIRS = $(SUBDIRS)
DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
am__relativize = \
dir0=`pwd`; \
sed_first='s,^\([^/]*\)/.*$$,\1,'; \
sed_rest='s,^[^/]*/*,,'; \
sed_last='s,^.*/\([^/]*\)$$,\1,'; \
sed_butlast='s,/*[^/]*$$,,'; \
while test -n "$$dir1"; do \
first=`echo "$$dir1" | sed -e "$$sed_first"`; \
if test "$$first" != "."; then \
if test "$$first" = ".."; then \
dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \
dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \
else \
first2=`echo "$$dir2" | sed -e "$$sed_first"`; \
if test "$$first2" = "$$first"; then \
dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \
else \
dir2="../$$dir2"; \
fi; \
dir0="$$dir0"/"$$first"; \
fi; \
fi; \
dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \
done; \
reldir="$$dir2"
ACLOCAL = @ACLOCAL@
AMTAR = @AMTAR@
AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@
AR = @AR@
AS = @AS@
AUTOCONF = @AUTOCONF@
AUTOHEADER = @AUTOHEADER@
AUTOMAKE = @AUTOMAKE@
AWK = @AWK@
BLAS_LIBS = @BLAS_LIBS@
CC = @CC@
CCDEPMODE = @CCDEPMODE@
CFLAGS = @CFLAGS@
CPP = @CPP@
CPPFLAGS = @CPPFLAGS@
CYGPATH_W = @CYGPATH_W@
DEFS = @DEFS@
DEPDIR = @DEPDIR@
DLLTOOL = @DLLTOOL@
DSYMUTIL = @DSYMUTIL@
DUMPBIN = @DUMPBIN@
ECHO_C = @ECHO_C@
ECHO_N = @ECHO_N@
ECHO_T = @ECHO_T@
EGREP = @EGREP@
EXEEXT = @EXEEXT@
# Force libparpack to be linked with the MPI Fortran compiler.
# The file dummy.f does not need to exist in the source tree.
F77 = $(MPIF77)
FFLAGS = @FFLAGS@
FGREP = @FGREP@
FLIBS = @FLIBS@
GREP = @GREP@
INSTALL = @INSTALL@
INSTALL_DATA = @INSTALL_DATA@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@
LAPACK_LIBS = @LAPACK_LIBS@
LD = @LD@
LDFLAGS = @LDFLAGS@
LIBOBJS = @LIBOBJS@
LIBS = @LIBS@
LIBTOOL = @LIBTOOL@
LIPO = @LIPO@
LN_S = @LN_S@
LTLIBOBJS = @LTLIBOBJS@
MAINT = @MAINT@
MAKEINFO = @MAKEINFO@
MANIFEST_TOOL = @MANIFEST_TOOL@
MKDIR_P = @MKDIR_P@
MPIF77 = @MPIF77@
MPILIBS = @MPILIBS@
NM = @NM@
NMEDIT = @NMEDIT@
OBJDUMP = @OBJDUMP@
OBJEXT = @OBJEXT@
OTOOL = @OTOOL@
OTOOL64 = @OTOOL64@
PACKAGE = @PACKAGE@
PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@
PACKAGE_NAME = @PACKAGE_NAME@
PACKAGE_STRING = @PACKAGE_STRING@
PACKAGE_TARNAME = @PACKAGE_TARNAME@
PACKAGE_URL = @PACKAGE_URL@
PACKAGE_VERSION = @PACKAGE_VERSION@
PATH_SEPARATOR = @PATH_SEPARATOR@
RANLIB = @RANLIB@
SED = @SED@
SET_MAKE = @SET_MAKE@
SHELL = @SHELL@
STRIP = @STRIP@
VERSION = @VERSION@
abs_builddir = @abs_builddir@
abs_srcdir = @abs_srcdir@
abs_top_builddir = @abs_top_builddir@
abs_top_srcdir = @abs_top_srcdir@
ac_ct_AR = @ac_ct_AR@
ac_ct_CC = @ac_ct_CC@
ac_ct_DUMPBIN = @ac_ct_DUMPBIN@
ac_ct_F77 = @ac_ct_F77@
am__include = @am__include@
am__leading_dot = @am__leading_dot@
am__quote = @am__quote@
am__tar = @am__tar@
am__untar = @am__untar@
bindir = @bindir@
build = @build@
build_alias = @build_alias@
build_cpu = @build_cpu@
build_os = @build_os@
build_vendor = @build_vendor@
builddir = @builddir@
datadir = @datadir@
datarootdir = @datarootdir@
docdir = @docdir@
dvidir = @dvidir@
exec_prefix = @exec_prefix@
host = @host@
host_alias = @host_alias@
host_cpu = @host_cpu@
host_os = @host_os@
host_vendor = @host_vendor@
htmldir = @htmldir@
includedir = @includedir@
infodir = @infodir@
install_sh = @install_sh@
libdir = @libdir@
libexecdir = @libexecdir@
localedir = @localedir@
localstatedir = @localstatedir@
mandir = @mandir@
mkdir_p = @mkdir_p@
oldincludedir = @oldincludedir@
pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
sysconfdir = @sysconfdir@
target_alias = @target_alias@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
SUBDIRS = UTIL SRC . EXAMPLES/MPI EXAMPLES/BLACS
lib_LTLIBRARIES = libparpack.la
libparpack_la_SOURCES =
nodist_EXTRA_libparpack_la_SOURCES = dummy.f
libparpack_la_LDFLAGS = -no-undefined -version-info 2:0
libparpack_la_LIBADD = \
$(top_builddir)/SRC/libarpacksrc.la \
$(top_builddir)/UTIL/libarpackutil.la \
$(top_builddir)/PARPACK/SRC/MPI/libparpacksrcmpi.la \
$(top_builddir)/PARPACK/UTIL/MPI/libparpackutilmpi.la \
$(BLAS_LIBS) $(LAPACK_LIBS) $(MPILIBS)
all: all-recursive
.SUFFIXES:
.SUFFIXES: .f .lo .o .obj
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
*$$dep*) \
( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \
&& { if test -f $@; then exit 0; else break; fi; }; \
exit 1;; \
esac; \
done; \
echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign PARPACK/Makefile'; \
$(am__cd) $(top_srcdir) && \
$(AUTOMAKE) --foreign PARPACK/Makefile
.PRECIOUS: Makefile
Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
@case '$?' in \
*config.status*) \
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \
*) \
echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \
cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \
esac;
$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
$(am__aclocal_m4_deps):
install-libLTLIBRARIES: $(lib_LTLIBRARIES)
@$(NORMAL_INSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
list2=; for p in $$list; do \
if test -f $$p; then \
list2="$$list2 $$p"; \
else :; fi; \
done; \
test -z "$$list2" || { \
echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \
$(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \
}
uninstall-libLTLIBRARIES:
@$(NORMAL_UNINSTALL)
@list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \
for p in $$list; do \
$(am__strip_dir) \
echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \
$(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \
done
clean-libLTLIBRARIES:
-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
@list='$(lib_LTLIBRARIES)'; \
locs=`for p in $$list; do echo $$p; done | \
sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \
sort -u`; \
test -z "$$locs" || { \
echo rm -f $${locs}; \
rm -f $${locs}; \
}
libparpack.la: $(libparpack_la_OBJECTS) $(libparpack_la_DEPENDENCIES) $(EXTRA_libparpack_la_DEPENDENCIES)
$(AM_V_F77LD)$(libparpack_la_LINK) -rpath $(libdir) $(libparpack_la_OBJECTS) $(libparpack_la_LIBADD) $(LIBS)
mostlyclean-compile:
-rm -f *.$(OBJEXT)
distclean-compile:
-rm -f *.tab.c
.f.o:
$(AM_V_F77)$(F77COMPILE) -c -o $@ $<
.f.obj:
$(AM_V_F77)$(F77COMPILE) -c -o $@ `$(CYGPATH_W) '$<'`
.f.lo:
$(AM_V_F77)$(LTF77COMPILE) -c -o $@ $<
mostlyclean-libtool:
-rm -f *.lo
clean-libtool:
-rm -rf .libs _libs
# This directory's subdirectories are mostly independent; you can cd
# into them and run 'make' without going through this Makefile.
# To change the values of 'make' variables: instead of editing Makefiles,
# (1) if the variable is set in 'config.status', edit 'config.status'
# (which will cause the Makefiles to be regenerated when you run 'make');
# (2) otherwise, pass the desired values on the 'make' command line.
$(am__recursive_targets):
@fail=; \
if $(am__make_keepgoing); then \
failcom='fail=yes'; \
else \
failcom='exit 1'; \
fi; \
dot_seen=no; \
target=`echo $@ | sed s/-recursive//`; \
case "$@" in \
distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \
*) list='$(SUBDIRS)' ;; \
esac; \
for subdir in $$list; do \
echo "Making $$target in $$subdir"; \
if test "$$subdir" = "."; then \
dot_seen=yes; \
local_target="$$target-am"; \
else \
local_target="$$target"; \
fi; \
($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
|| eval $$failcom; \
done; \
if test "$$dot_seen" = "no"; then \
$(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
fi; test -z "$$fail"
ID: $(am__tagged_files)
$(am__define_uniq_tagged_files); mkid -fID $$unique
tags: tags-recursive
TAGS: tags
tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
set x; \
here=`pwd`; \
if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \
include_option=--etags-include; \
empty_fix=.; \
else \
include_option=--include; \
empty_fix=; \
fi; \
list='$(SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
test ! -f $$subdir/TAGS || \
set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \
fi; \
done; \
$(am__define_uniq_tagged_files); \
shift; \
if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \
test -n "$$unique" || unique=$$empty_fix; \
if test $$# -gt 0; then \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
"$$@" $$unique; \
else \
$(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \
$$unique; \
fi; \
fi
ctags: ctags-recursive
CTAGS: ctags
ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files)
$(am__define_uniq_tagged_files); \
test -z "$(CTAGS_ARGS)$$unique" \
|| $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \
$$unique
GTAGS:
here=`$(am__cd) $(top_builddir) && pwd` \
&& $(am__cd) $(top_srcdir) \
&& gtags -i $(GTAGS_ARGS) "$$here"
cscopelist: cscopelist-recursive
cscopelist-am: $(am__tagged_files)
list='$(am__tagged_files)'; \
case "$(srcdir)" in \
[\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \
*) sdir=$(subdir)/$(srcdir) ;; \
esac; \
for i in $$list; do \
if test -f "$$i"; then \
echo "$(subdir)/$$i"; \
else \
echo "$$sdir/$$i"; \
fi; \
done >> $(top_builddir)/cscope.files
distclean-tags:
-rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags
distdir: $(DISTFILES)
@srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \
list='$(DISTFILES)'; \
dist_files=`for file in $$list; do echo $$file; done | \
sed -e "s|^$$srcdirstrip/||;t" \
-e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \
case $$dist_files in \
*/*) $(MKDIR_P) `echo "$$dist_files" | \
sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \
sort -u` ;; \
esac; \
for file in $$dist_files; do \
if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \
if test -d $$d/$$file; then \
dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \
if test -d "$(distdir)/$$file"; then \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \
cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \
find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \
fi; \
cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \
else \
test -f "$(distdir)/$$file" \
|| cp -p $$d/$$file "$(distdir)/$$file" \
|| exit 1; \
fi; \
done
@list='$(DIST_SUBDIRS)'; for subdir in $$list; do \
if test "$$subdir" = .; then :; else \
$(am__make_dryrun) \
|| test -d "$(distdir)/$$subdir" \
|| $(MKDIR_P) "$(distdir)/$$subdir" \
|| exit 1; \
dir1=$$subdir; dir2="$(distdir)/$$subdir"; \
$(am__relativize); \
new_distdir=$$reldir; \
dir1=$$subdir; dir2="$(top_distdir)"; \
$(am__relativize); \
new_top_distdir=$$reldir; \
echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \
echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \
($(am__cd) $$subdir && \
$(MAKE) $(AM_MAKEFLAGS) \
top_distdir="$$new_top_distdir" \
distdir="$$new_distdir" \
am__remove_distdir=: \
am__skip_length_check=: \
am__skip_mode_fix=: \
distdir) \
|| exit 1; \
fi; \
done
check-am: all-am
check: check-recursive
all-am: Makefile $(LTLIBRARIES)
installdirs: installdirs-recursive
installdirs-am:
for dir in "$(DESTDIR)$(libdir)"; do \
test -z "$$dir" || $(MKDIR_P) "$$dir"; \
done
install: install-recursive
install-exec: install-exec-recursive
install-data: install-data-recursive
uninstall: uninstall-recursive
install-am: all-am
@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
installcheck: installcheck-recursive
install-strip:
if test -z '$(STRIP)'; then \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
install; \
else \
$(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \
install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \
"INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \
fi
mostlyclean-generic:
clean-generic:
distclean-generic:
-test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES)
-test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES)
maintainer-clean-generic:
@echo "This command is intended for maintainers to use"
@echo "it deletes files that may require special tools to rebuild."
clean: clean-recursive
clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \
mostlyclean-am
distclean: distclean-recursive
-rm -f Makefile
distclean-am: clean-am distclean-compile distclean-generic \
distclean-tags
dvi: dvi-recursive
dvi-am:
html: html-recursive
html-am:
info: info-recursive
info-am:
install-data-am:
install-dvi: install-dvi-recursive
install-dvi-am:
install-exec-am: install-libLTLIBRARIES
install-html: install-html-recursive
install-html-am:
install-info: install-info-recursive
install-info-am:
install-man:
install-pdf: install-pdf-recursive
install-pdf-am:
install-ps: install-ps-recursive
install-ps-am:
installcheck-am:
maintainer-clean: maintainer-clean-recursive
-rm -f Makefile
maintainer-clean-am: distclean-am maintainer-clean-generic
mostlyclean: mostlyclean-recursive
mostlyclean-am: mostlyclean-compile mostlyclean-generic \
mostlyclean-libtool
pdf: pdf-recursive
pdf-am:
ps: ps-recursive
ps-am:
uninstall-am: uninstall-libLTLIBRARIES
.MAKE: $(am__recursive_targets) install-am install-strip
.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \
check-am clean clean-generic clean-libLTLIBRARIES \
clean-libtool cscopelist-am ctags ctags-am distclean \
distclean-compile distclean-generic distclean-libtool \
distclean-tags distdir dvi dvi-am html html-am info info-am \
install install-am install-data install-data-am install-dvi \
install-dvi-am install-exec install-exec-am install-html \
install-html-am install-info install-info-am \
install-libLTLIBRARIES install-man install-pdf install-pdf-am \
install-ps install-ps-am install-strip installcheck \
installcheck-am installdirs installdirs-am maintainer-clean \
maintainer-clean-generic mostlyclean mostlyclean-compile \
mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \
tags tags-am uninstall uninstall-am uninstall-libLTLIBRARIES
# Tell versions [3.59,3.63) of GNU make to not export all variables.
# Otherwise a system limit (for SysV at least) may be exceeded.
.NOEXPORT:
arpack-ng-3.1.5/ltmain.sh 0000644 0001750 0001750 00001051522 12277373057 012147 0000000 0000000
# libtool (GNU libtool) 2.4.2
# Written by Gordon Matzigkeit , 1996
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, 2006,
# 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
# This is free software; see the source for copying conditions. There is NO
# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# GNU Libtool is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# As a special exception to the GNU General Public License,
# if you distribute this file as part of a program or library that
# is built using GNU Libtool, you may include this file under the
# same distribution terms that you use for the rest of that program.
#
# GNU Libtool is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Libtool; see the file COPYING. If not, a copy
# can be downloaded from http://www.gnu.org/licenses/gpl.html,
# or obtained by writing to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# Usage: $progname [OPTION]... [MODE-ARG]...
#
# Provide generalized library-building support services.
#
# --config show all configuration variables
# --debug enable verbose shell tracing
# -n, --dry-run display commands without modifying any files
# --features display basic configuration information and exit
# --mode=MODE use operation mode MODE
# --preserve-dup-deps don't remove duplicate dependency libraries
# --quiet, --silent don't print informational messages
# --no-quiet, --no-silent
# print informational messages (default)
# --no-warn don't display warning messages
# --tag=TAG use configuration variables from tag TAG
# -v, --verbose print more informational messages than default
# --no-verbose don't print the extra informational messages
# --version print version information
# -h, --help, --help-all print short, long, or detailed help message
#
# MODE must be one of the following:
#
# clean remove files from the build directory
# compile compile a source file into a libtool object
# execute automatically set library path, then run a program
# finish complete the installation of libtool libraries
# install install libraries or executables
# link create a library or an executable
# uninstall remove libraries from an installed directory
#
# MODE-ARGS vary depending on the MODE. When passed as first option,
# `--mode=MODE' may be abbreviated as `MODE' or a unique abbreviation of that.
# Try `$progname --help --mode=MODE' for a more detailed description of MODE.
#
# When reporting a bug, please describe a test case to reproduce it and
# include the following information:
#
# host-triplet: $host
# shell: $SHELL
# compiler: $LTCC
# compiler flags: $LTCFLAGS
# linker: $LD (gnu? $with_gnu_ld)
# $progname: (GNU libtool) 2.4.2
# automake: $automake_version
# autoconf: $autoconf_version
#
# Report bugs to .
# GNU libtool home page: .
# General help using GNU software: .
PROGRAM=libtool
PACKAGE=libtool
VERSION=2.4.2
TIMESTAMP=""
package_revision=1.3337
# Be Bourne compatible
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
case `(set -o) 2>/dev/null` in *posix*) set -o posix;; esac
fi
BIN_SH=xpg4; export BIN_SH # for Tru64
DUALCASE=1; export DUALCASE # for MKS sh
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
$1
_LTECHO_EOF'
}
# NLS nuisances: We save the old values to restore during execute mode.
lt_user_locale=
lt_safe_locale=
for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
do
eval "if test \"\${$lt_var+set}\" = set; then
save_$lt_var=\$$lt_var
$lt_var=C
export $lt_var
lt_user_locale=\"$lt_var=\\\$save_\$lt_var; \$lt_user_locale\"
lt_safe_locale=\"$lt_var=C; \$lt_safe_locale\"
fi"
done
LC_ALL=C
LANGUAGE=C
export LANGUAGE LC_ALL
$lt_unset CDPATH
# Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh
# is ksh but when the shell is invoked as "sh" and the current value of
# the _XPG environment variable is not equal to 1 (one), the special
# positional parameter $0, within a function call, is the name of the
# function.
progpath="$0"
: ${CP="cp -f"}
test "${ECHO+set}" = set || ECHO=${as_echo-'printf %s\n'}
: ${MAKE="make"}
: ${MKDIR="mkdir"}
: ${MV="mv -f"}
: ${RM="rm -f"}
: ${SHELL="${CONFIG_SHELL-/bin/sh}"}
: ${Xsed="$SED -e 1s/^X//"}
# Global variables:
EXIT_SUCCESS=0
EXIT_FAILURE=1
EXIT_MISMATCH=63 # $? = 63 is used to indicate version mismatch to missing.
EXIT_SKIP=77 # $? = 77 is used to indicate a skipped test to automake.
exit_status=$EXIT_SUCCESS
# Make sure IFS has a sensible default
lt_nl='
'
IFS=" $lt_nl"
dirname="s,/[^/]*$,,"
basename="s,^.*/,,"
# func_dirname file append nondir_replacement
# Compute the dirname of FILE. If nonempty, add APPEND to the result,
# otherwise set result to NONDIR_REPLACEMENT.
func_dirname ()
{
func_dirname_result=`$ECHO "${1}" | $SED "$dirname"`
if test "X$func_dirname_result" = "X${1}"; then
func_dirname_result="${3}"
else
func_dirname_result="$func_dirname_result${2}"
fi
} # func_dirname may be replaced by extended shell implementation
# func_basename file
func_basename ()
{
func_basename_result=`$ECHO "${1}" | $SED "$basename"`
} # func_basename may be replaced by extended shell implementation
# func_dirname_and_basename file append nondir_replacement
# perform func_basename and func_dirname in a single function
# call:
# dirname: Compute the dirname of FILE. If nonempty,
# add APPEND to the result, otherwise set result
# to NONDIR_REPLACEMENT.
# value returned in "$func_dirname_result"
# basename: Compute filename of FILE.
# value retuned in "$func_basename_result"
# Implementation must be kept synchronized with func_dirname
# and func_basename. For efficiency, we do not delegate to
# those functions but instead duplicate the functionality here.
func_dirname_and_basename ()
{
# Extract subdirectory from the argument.
func_dirname_result=`$ECHO "${1}" | $SED -e "$dirname"`
if test "X$func_dirname_result" = "X${1}"; then
func_dirname_result="${3}"
else
func_dirname_result="$func_dirname_result${2}"
fi
func_basename_result=`$ECHO "${1}" | $SED -e "$basename"`
} # func_dirname_and_basename may be replaced by extended shell implementation
# func_stripname prefix suffix name
# strip PREFIX and SUFFIX off of NAME.
# PREFIX and SUFFIX must not contain globbing or regex special
# characters, hashes, percent signs, but SUFFIX may contain a leading
# dot (in which case that matches only a dot).
# func_strip_suffix prefix name
func_stripname ()
{
case ${2} in
.*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;;
*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;;
esac
} # func_stripname may be replaced by extended shell implementation
# These SED scripts presuppose an absolute path with a trailing slash.
pathcar='s,^/\([^/]*\).*$,\1,'
pathcdr='s,^/[^/]*,,'
removedotparts=':dotsl
s@/\./@/@g
t dotsl
s,/\.$,/,'
collapseslashes='s@/\{1,\}@/@g'
finalslash='s,/*$,/,'
# func_normal_abspath PATH
# Remove doubled-up and trailing slashes, "." path components,
# and cancel out any ".." path components in PATH after making
# it an absolute path.
# value returned in "$func_normal_abspath_result"
func_normal_abspath ()
{
# Start from root dir and reassemble the path.
func_normal_abspath_result=
func_normal_abspath_tpath=$1
func_normal_abspath_altnamespace=
case $func_normal_abspath_tpath in
"")
# Empty path, that just means $cwd.
func_stripname '' '/' "`pwd`"
func_normal_abspath_result=$func_stripname_result
return
;;
# The next three entries are used to spot a run of precisely
# two leading slashes without using negated character classes;
# we take advantage of case's first-match behaviour.
///*)
# Unusual form of absolute path, do nothing.
;;
//*)
# Not necessarily an ordinary path; POSIX reserves leading '//'
# and for example Cygwin uses it to access remote file shares
# over CIFS/SMB, so we conserve a leading double slash if found.
func_normal_abspath_altnamespace=/
;;
/*)
# Absolute path, do nothing.
;;
*)
# Relative path, prepend $cwd.
func_normal_abspath_tpath=`pwd`/$func_normal_abspath_tpath
;;
esac
# Cancel out all the simple stuff to save iterations. We also want
# the path to end with a slash for ease of parsing, so make sure
# there is one (and only one) here.
func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$removedotparts" -e "$collapseslashes" -e "$finalslash"`
while :; do
# Processed it all yet?
if test "$func_normal_abspath_tpath" = / ; then
# If we ascended to the root using ".." the result may be empty now.
if test -z "$func_normal_abspath_result" ; then
func_normal_abspath_result=/
fi
break
fi
func_normal_abspath_tcomponent=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$pathcar"`
func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \
-e "$pathcdr"`
# Figure out what to do with it
case $func_normal_abspath_tcomponent in
"")
# Trailing empty path component, ignore it.
;;
..)
# Parent dir; strip last assembled component from result.
func_dirname "$func_normal_abspath_result"
func_normal_abspath_result=$func_dirname_result
;;
*)
# Actual path component, append it.
func_normal_abspath_result=$func_normal_abspath_result/$func_normal_abspath_tcomponent
;;
esac
done
# Restore leading double-slash if one was found on entry.
func_normal_abspath_result=$func_normal_abspath_altnamespace$func_normal_abspath_result
}
# func_relative_path SRCDIR DSTDIR
# generates a relative path from SRCDIR to DSTDIR, with a trailing
# slash if non-empty, suitable for immediately appending a filename
# without needing to append a separator.
# value returned in "$func_relative_path_result"
func_relative_path ()
{
func_relative_path_result=
func_normal_abspath "$1"
func_relative_path_tlibdir=$func_normal_abspath_result
func_normal_abspath "$2"
func_relative_path_tbindir=$func_normal_abspath_result
# Ascend the tree starting from libdir
while :; do
# check if we have found a prefix of bindir
case $func_relative_path_tbindir in
$func_relative_path_tlibdir)
# found an exact match
func_relative_path_tcancelled=
break
;;
$func_relative_path_tlibdir*)
# found a matching prefix
func_stripname "$func_relative_path_tlibdir" '' "$func_relative_path_tbindir"
func_relative_path_tcancelled=$func_stripname_result
if test -z "$func_relative_path_result"; then
func_relative_path_result=.
fi
break
;;
*)
func_dirname $func_relative_path_tlibdir
func_relative_path_tlibdir=${func_dirname_result}
if test "x$func_relative_path_tlibdir" = x ; then
# Have to descend all the way to the root!
func_relative_path_result=../$func_relative_path_result
func_relative_path_tcancelled=$func_relative_path_tbindir
break
fi
func_relative_path_result=../$func_relative_path_result
;;
esac
done
# Now calculate path; take care to avoid doubling-up slashes.
func_stripname '' '/' "$func_relative_path_result"
func_relative_path_result=$func_stripname_result
func_stripname '/' '/' "$func_relative_path_tcancelled"
if test "x$func_stripname_result" != x ; then
func_relative_path_result=${func_relative_path_result}/${func_stripname_result}
fi
# Normalisation. If bindir is libdir, return empty string,
# else relative path ending with a slash; either way, target
# file name can be directly appended.
if test ! -z "$func_relative_path_result"; then
func_stripname './' '' "$func_relative_path_result/"
func_relative_path_result=$func_stripname_result
fi
}
# The name of this program:
func_dirname_and_basename "$progpath"
progname=$func_basename_result
# Make sure we have an absolute path for reexecution:
case $progpath in
[\\/]*|[A-Za-z]:\\*) ;;
*[\\/]*)
progdir=$func_dirname_result
progdir=`cd "$progdir" && pwd`
progpath="$progdir/$progname"
;;
*)
save_IFS="$IFS"
IFS=${PATH_SEPARATOR-:}
for progdir in $PATH; do
IFS="$save_IFS"
test -x "$progdir/$progname" && break
done
IFS="$save_IFS"
test -n "$progdir" || progdir=`pwd`
progpath="$progdir/$progname"
;;
esac
# Sed substitution that helps us do robust quoting. It backslashifies
# metacharacters that are still active within double-quoted strings.
Xsed="${SED}"' -e 1s/^X//'
sed_quote_subst='s/\([`"$\\]\)/\\\1/g'
# Same as above, but do not quote variable references.
double_quote_subst='s/\(["`\\]\)/\\\1/g'
# Sed substitution that turns a string into a regex matching for the
# string literally.
sed_make_literal_regex='s,[].[^$\\*\/],\\&,g'
# Sed substitution that converts a w32 file name or path
# which contains forward slashes, into one that contains
# (escaped) backslashes. A very naive implementation.
lt_sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g'
# Re-`\' parameter expansions in output of double_quote_subst that were
# `\'-ed in input to the same. If an odd number of `\' preceded a '$'
# in input to double_quote_subst, that '$' was protected from expansion.
# Since each input `\' is now two `\'s, look for any number of runs of
# four `\'s followed by two `\'s and then a '$'. `\' that '$'.
bs='\\'
bs2='\\\\'
bs4='\\\\\\\\'
dollar='\$'
sed_double_backslash="\
s/$bs4/&\\
/g
s/^$bs2$dollar/$bs&/
s/\\([^$bs]\\)$bs2$dollar/\\1$bs2$bs$dollar/g
s/\n//g"
# Standard options:
opt_dry_run=false
opt_help=false
opt_quiet=false
opt_verbose=false
opt_warning=:
# func_echo arg...
# Echo program name prefixed message, along with the current mode
# name if it has been set yet.
func_echo ()
{
$ECHO "$progname: ${opt_mode+$opt_mode: }$*"
}
# func_verbose arg...
# Echo program name prefixed message in verbose mode only.
func_verbose ()
{
$opt_verbose && func_echo ${1+"$@"}
# A bug in bash halts the script if the last line of a function
# fails when set -e is in force, so we need another command to
# work around that:
:
}
# func_echo_all arg...
# Invoke $ECHO with all args, space-separated.
func_echo_all ()
{
$ECHO "$*"
}
# func_error arg...
# Echo program name prefixed message to standard error.
func_error ()
{
$ECHO "$progname: ${opt_mode+$opt_mode: }"${1+"$@"} 1>&2
}
# func_warning arg...
# Echo program name prefixed warning message to standard error.
func_warning ()
{
$opt_warning && $ECHO "$progname: ${opt_mode+$opt_mode: }warning: "${1+"$@"} 1>&2
# bash bug again:
:
}
# func_fatal_error arg...
# Echo program name prefixed message to standard error, and exit.
func_fatal_error ()
{
func_error ${1+"$@"}
exit $EXIT_FAILURE
}
# func_fatal_help arg...
# Echo program name prefixed message to standard error, followed by
# a help hint, and exit.
func_fatal_help ()
{
func_error ${1+"$@"}
func_fatal_error "$help"
}
help="Try \`$progname --help' for more information." ## default
# func_grep expression filename
# Check whether EXPRESSION matches any line of FILENAME, without output.
func_grep ()
{
$GREP "$1" "$2" >/dev/null 2>&1
}
# func_mkdir_p directory-path
# Make sure the entire path to DIRECTORY-PATH is available.
func_mkdir_p ()
{
my_directory_path="$1"
my_dir_list=
if test -n "$my_directory_path" && test "$opt_dry_run" != ":"; then
# Protect directory names starting with `-'
case $my_directory_path in
-*) my_directory_path="./$my_directory_path" ;;
esac
# While some portion of DIR does not yet exist...
while test ! -d "$my_directory_path"; do
# ...make a list in topmost first order. Use a colon delimited
# list incase some portion of path contains whitespace.
my_dir_list="$my_directory_path:$my_dir_list"
# If the last portion added has no slash in it, the list is done
case $my_directory_path in */*) ;; *) break ;; esac
# ...otherwise throw away the child directory and loop
my_directory_path=`$ECHO "$my_directory_path" | $SED -e "$dirname"`
done
my_dir_list=`$ECHO "$my_dir_list" | $SED 's,:*$,,'`
save_mkdir_p_IFS="$IFS"; IFS=':'
for my_dir in $my_dir_list; do
IFS="$save_mkdir_p_IFS"
# mkdir can fail with a `File exist' error if two processes
# try to create one of the directories concurrently. Don't
# stop in that case!
$MKDIR "$my_dir" 2>/dev/null || :
done
IFS="$save_mkdir_p_IFS"
# Bail out if we (or some other process) failed to create a directory.
test -d "$my_directory_path" || \
func_fatal_error "Failed to create \`$1'"
fi
}
# func_mktempdir [string]
# Make a temporary directory that won't clash with other running
# libtool processes, and avoids race conditions if possible. If
# given, STRING is the basename for that directory.
func_mktempdir ()
{
my_template="${TMPDIR-/tmp}/${1-$progname}"
if test "$opt_dry_run" = ":"; then
# Return a directory name, but don't create it in dry-run mode
my_tmpdir="${my_template}-$$"
else
# If mktemp works, use that first and foremost
my_tmpdir=`mktemp -d "${my_template}-XXXXXXXX" 2>/dev/null`
if test ! -d "$my_tmpdir"; then
# Failing that, at least try and use $RANDOM to avoid a race
my_tmpdir="${my_template}-${RANDOM-0}$$"
save_mktempdir_umask=`umask`
umask 0077
$MKDIR "$my_tmpdir"
umask $save_mktempdir_umask
fi
# If we're not in dry-run mode, bomb out on failure
test -d "$my_tmpdir" || \
func_fatal_error "cannot create temporary directory \`$my_tmpdir'"
fi
$ECHO "$my_tmpdir"
}
# func_quote_for_eval arg
# Aesthetically quote ARG to be evaled later.
# This function returns two values: FUNC_QUOTE_FOR_EVAL_RESULT
# is double-quoted, suitable for a subsequent eval, whereas
# FUNC_QUOTE_FOR_EVAL_UNQUOTED_RESULT has merely all characters
# which are still active within double quotes backslashified.
func_quote_for_eval ()
{
case $1 in
*[\\\`\"\$]*)
func_quote_for_eval_unquoted_result=`$ECHO "$1" | $SED "$sed_quote_subst"` ;;
*)
func_quote_for_eval_unquoted_result="$1" ;;
esac
case $func_quote_for_eval_unquoted_result in
# Double-quote args containing shell metacharacters to delay
# word splitting, command substitution and and variable
# expansion for a subsequent eval.
# Many Bourne shells cannot handle close brackets correctly
# in scan sets, so we specify it separately.
*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
func_quote_for_eval_result="\"$func_quote_for_eval_unquoted_result\""
;;
*)
func_quote_for_eval_result="$func_quote_for_eval_unquoted_result"
esac
}
# func_quote_for_expand arg
# Aesthetically quote ARG to be evaled later; same as above,
# but do not quote variable references.
func_quote_for_expand ()
{
case $1 in
*[\\\`\"]*)
my_arg=`$ECHO "$1" | $SED \
-e "$double_quote_subst" -e "$sed_double_backslash"` ;;
*)
my_arg="$1" ;;
esac
case $my_arg in
# Double-quote args containing shell metacharacters to delay
# word splitting and command substitution for a subsequent eval.
# Many Bourne shells cannot handle close brackets correctly
# in scan sets, so we specify it separately.
*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"")
my_arg="\"$my_arg\""
;;
esac
func_quote_for_expand_result="$my_arg"
}
# func_show_eval cmd [fail_exp]
# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
# is given, then evaluate it.
func_show_eval ()
{
my_cmd="$1"
my_fail_exp="${2-:}"
${opt_silent-false} || {
func_quote_for_expand "$my_cmd"
eval "func_echo $func_quote_for_expand_result"
}
if ${opt_dry_run-false}; then :; else
eval "$my_cmd"
my_status=$?
if test "$my_status" -eq 0; then :; else
eval "(exit $my_status); $my_fail_exp"
fi
fi
}
# func_show_eval_locale cmd [fail_exp]
# Unless opt_silent is true, then output CMD. Then, if opt_dryrun is
# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP
# is given, then evaluate it. Use the saved locale for evaluation.
func_show_eval_locale ()
{
my_cmd="$1"
my_fail_exp="${2-:}"
${opt_silent-false} || {
func_quote_for_expand "$my_cmd"
eval "func_echo $func_quote_for_expand_result"
}
if ${opt_dry_run-false}; then :; else
eval "$lt_user_locale
$my_cmd"
my_status=$?
eval "$lt_safe_locale"
if test "$my_status" -eq 0; then :; else
eval "(exit $my_status); $my_fail_exp"
fi
fi
}
# func_tr_sh
# Turn $1 into a string suitable for a shell variable name.
# Result is stored in $func_tr_sh_result. All characters
# not in the set a-zA-Z0-9_ are replaced with '_'. Further,
# if $1 begins with a digit, a '_' is prepended as well.
func_tr_sh ()
{
case $1 in
[0-9]* | *[!a-zA-Z0-9_]*)
func_tr_sh_result=`$ECHO "$1" | $SED 's/^\([0-9]\)/_\1/; s/[^a-zA-Z0-9_]/_/g'`
;;
* )
func_tr_sh_result=$1
;;
esac
}
# func_version
# Echo version message to standard output and exit.
func_version ()
{
$opt_debug
$SED -n '/(C)/!b go
:more
/\./!{
N
s/\n# / /
b more
}
:go
/^# '$PROGRAM' (GNU /,/# warranty; / {
s/^# //
s/^# *$//
s/\((C)\)[ 0-9,-]*\( [1-9][0-9]*\)/\1\2/
p
}' < "$progpath"
exit $?
}
# func_usage
# Echo short help message to standard output and exit.
func_usage ()
{
$opt_debug
$SED -n '/^# Usage:/,/^# *.*--help/ {
s/^# //
s/^# *$//
s/\$progname/'$progname'/
p
}' < "$progpath"
echo
$ECHO "run \`$progname --help | more' for full usage"
exit $?
}
# func_help [NOEXIT]
# Echo long help message to standard output and exit,
# unless 'noexit' is passed as argument.
func_help ()
{
$opt_debug
$SED -n '/^# Usage:/,/# Report bugs to/ {
:print
s/^# //
s/^# *$//
s*\$progname*'$progname'*
s*\$host*'"$host"'*
s*\$SHELL*'"$SHELL"'*
s*\$LTCC*'"$LTCC"'*
s*\$LTCFLAGS*'"$LTCFLAGS"'*
s*\$LD*'"$LD"'*
s/\$with_gnu_ld/'"$with_gnu_ld"'/
s/\$automake_version/'"`(${AUTOMAKE-automake} --version) 2>/dev/null |$SED 1q`"'/
s/\$autoconf_version/'"`(${AUTOCONF-autoconf} --version) 2>/dev/null |$SED 1q`"'/
p
d
}
/^# .* home page:/b print
/^# General help using/b print
' < "$progpath"
ret=$?
if test -z "$1"; then
exit $ret
fi
}
# func_missing_arg argname
# Echo program name prefixed message to standard error and set global
# exit_cmd.
func_missing_arg ()
{
$opt_debug
func_error "missing argument for $1."
exit_cmd=exit
}
# func_split_short_opt shortopt
# Set func_split_short_opt_name and func_split_short_opt_arg shell
# variables after splitting SHORTOPT after the 2nd character.
func_split_short_opt ()
{
my_sed_short_opt='1s/^\(..\).*$/\1/;q'
my_sed_short_rest='1s/^..\(.*\)$/\1/;q'
func_split_short_opt_name=`$ECHO "$1" | $SED "$my_sed_short_opt"`
func_split_short_opt_arg=`$ECHO "$1" | $SED "$my_sed_short_rest"`
} # func_split_short_opt may be replaced by extended shell implementation
# func_split_long_opt longopt
# Set func_split_long_opt_name and func_split_long_opt_arg shell
# variables after splitting LONGOPT at the `=' sign.
func_split_long_opt ()
{
my_sed_long_opt='1s/^\(--[^=]*\)=.*/\1/;q'
my_sed_long_arg='1s/^--[^=]*=//'
func_split_long_opt_name=`$ECHO "$1" | $SED "$my_sed_long_opt"`
func_split_long_opt_arg=`$ECHO "$1" | $SED "$my_sed_long_arg"`
} # func_split_long_opt may be replaced by extended shell implementation
exit_cmd=:
magic="%%%MAGIC variable%%%"
magic_exe="%%%MAGIC EXE variable%%%"
# Global variables.
nonopt=
preserve_args=
lo2o="s/\\.lo\$/.${objext}/"
o2lo="s/\\.${objext}\$/.lo/"
extracted_archives=
extracted_serial=0
# If this variable is set in any of the actions, the command in it
# will be execed at the end. This prevents here-documents from being
# left over by shells.
exec_cmd=
# func_append var value
# Append VALUE to the end of shell variable VAR.
func_append ()
{
eval "${1}=\$${1}\${2}"
} # func_append may be replaced by extended shell implementation
# func_append_quoted var value
# Quote VALUE and append to the end of shell variable VAR, separated
# by a space.
func_append_quoted ()
{
func_quote_for_eval "${2}"
eval "${1}=\$${1}\\ \$func_quote_for_eval_result"
} # func_append_quoted may be replaced by extended shell implementation
# func_arith arithmetic-term...
func_arith ()
{
func_arith_result=`expr "${@}"`
} # func_arith may be replaced by extended shell implementation
# func_len string
# STRING may not start with a hyphen.
func_len ()
{
func_len_result=`expr "${1}" : ".*" 2>/dev/null || echo $max_cmd_len`
} # func_len may be replaced by extended shell implementation
# func_lo2o object
func_lo2o ()
{
func_lo2o_result=`$ECHO "${1}" | $SED "$lo2o"`
} # func_lo2o may be replaced by extended shell implementation
# func_xform libobj-or-source
func_xform ()
{
func_xform_result=`$ECHO "${1}" | $SED 's/\.[^.]*$/.lo/'`
} # func_xform may be replaced by extended shell implementation
# func_fatal_configuration arg...
# Echo program name prefixed message to standard error, followed by
# a configuration failure hint, and exit.
func_fatal_configuration ()
{
func_error ${1+"$@"}
func_error "See the $PACKAGE documentation for more information."
func_fatal_error "Fatal configuration error."
}
# func_config
# Display the configuration for all the tags in this script.
func_config ()
{
re_begincf='^# ### BEGIN LIBTOOL'
re_endcf='^# ### END LIBTOOL'
# Default configuration.
$SED "1,/$re_begincf CONFIG/d;/$re_endcf CONFIG/,\$d" < "$progpath"
# Now print the configurations for the tags.
for tagname in $taglist; do
$SED -n "/$re_begincf TAG CONFIG: $tagname\$/,/$re_endcf TAG CONFIG: $tagname\$/p" < "$progpath"
done
exit $?
}
# func_features
# Display the features supported by this script.
func_features ()
{
echo "host: $host"
if test "$build_libtool_libs" = yes; then
echo "enable shared libraries"
else
echo "disable shared libraries"
fi
if test "$build_old_libs" = yes; then
echo "enable static libraries"
else
echo "disable static libraries"
fi
exit $?
}
# func_enable_tag tagname
# Verify that TAGNAME is valid, and either flag an error and exit, or
# enable the TAGNAME tag. We also add TAGNAME to the global $taglist
# variable here.
func_enable_tag ()
{
# Global variable:
tagname="$1"
re_begincf="^# ### BEGIN LIBTOOL TAG CONFIG: $tagname\$"
re_endcf="^# ### END LIBTOOL TAG CONFIG: $tagname\$"
sed_extractcf="/$re_begincf/,/$re_endcf/p"
# Validate tagname.
case $tagname in
*[!-_A-Za-z0-9,/]*)
func_fatal_error "invalid tag name: $tagname"
;;
esac
# Don't test for the "default" C tag, as we know it's
# there but not specially marked.
case $tagname in
CC) ;;
*)
if $GREP "$re_begincf" "$progpath" >/dev/null 2>&1; then
taglist="$taglist $tagname"
# Evaluate the configuration. Be careful to quote the path
# and the sed script, to avoid splitting on whitespace, but
# also don't use non-portable quotes within backquotes within
# quotes we have to do it in 2 steps:
extractedcf=`$SED -n -e "$sed_extractcf" < "$progpath"`
eval "$extractedcf"
else
func_error "ignoring unknown tag $tagname"
fi
;;
esac
}
# func_check_version_match
# Ensure that we are using m4 macros, and libtool script from the same
# release of libtool.
func_check_version_match ()
{
if test "$package_revision" != "$macro_revision"; then
if test "$VERSION" != "$macro_version"; then
if test -z "$macro_version"; then
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
$progname: definition of this LT_INIT comes from an older release.
$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
$progname: and run autoconf again.
_LT_EOF
else
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, but the
$progname: definition of this LT_INIT comes from $PACKAGE $macro_version.
$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION
$progname: and run autoconf again.
_LT_EOF
fi
else
cat >&2 <<_LT_EOF
$progname: Version mismatch error. This is $PACKAGE $VERSION, revision $package_revision,
$progname: but the definition of this LT_INIT comes from revision $macro_revision.
$progname: You should recreate aclocal.m4 with macros from revision $package_revision
$progname: of $PACKAGE $VERSION and run autoconf again.
_LT_EOF
fi
exit $EXIT_MISMATCH
fi
}
# Shorthand for --mode=foo, only valid as the first argument
case $1 in
clean|clea|cle|cl)
shift; set dummy --mode clean ${1+"$@"}; shift
;;
compile|compil|compi|comp|com|co|c)
shift; set dummy --mode compile ${1+"$@"}; shift
;;
execute|execut|execu|exec|exe|ex|e)
shift; set dummy --mode execute ${1+"$@"}; shift
;;
finish|finis|fini|fin|fi|f)
shift; set dummy --mode finish ${1+"$@"}; shift
;;
install|instal|insta|inst|ins|in|i)
shift; set dummy --mode install ${1+"$@"}; shift
;;
link|lin|li|l)
shift; set dummy --mode link ${1+"$@"}; shift
;;
uninstall|uninstal|uninsta|uninst|unins|unin|uni|un|u)
shift; set dummy --mode uninstall ${1+"$@"}; shift
;;
esac
# Option defaults:
opt_debug=:
opt_dry_run=false
opt_config=false
opt_preserve_dup_deps=false
opt_features=false
opt_finish=false
opt_help=false
opt_help_all=false
opt_silent=:
opt_warning=:
opt_verbose=:
opt_silent=false
opt_verbose=false
# Parse options once, thoroughly. This comes as soon as possible in the
# script to make things like `--version' happen as quickly as we can.
{
# this just eases exit handling
while test $# -gt 0; do
opt="$1"
shift
case $opt in
--debug|-x) opt_debug='set -x'
func_echo "enabling shell trace mode"
$opt_debug
;;
--dry-run|--dryrun|-n)
opt_dry_run=:
;;
--config)
opt_config=:
func_config
;;
--dlopen|-dlopen)
optarg="$1"
opt_dlopen="${opt_dlopen+$opt_dlopen
}$optarg"
shift
;;
--preserve-dup-deps)
opt_preserve_dup_deps=:
;;
--features)
opt_features=:
func_features
;;
--finish)
opt_finish=:
set dummy --mode finish ${1+"$@"}; shift
;;
--help)
opt_help=:
;;
--help-all)
opt_help_all=:
opt_help=': help-all'
;;
--mode)
test $# = 0 && func_missing_arg $opt && break
optarg="$1"
opt_mode="$optarg"
case $optarg in
# Valid mode arguments:
clean|compile|execute|finish|install|link|relink|uninstall) ;;
# Catch anything else as an error
*) func_error "invalid argument for $opt"
exit_cmd=exit
break
;;
esac
shift
;;
--no-silent|--no-quiet)
opt_silent=false
func_append preserve_args " $opt"
;;
--no-warning|--no-warn)
opt_warning=false
func_append preserve_args " $opt"
;;
--no-verbose)
opt_verbose=false
func_append preserve_args " $opt"
;;
--silent|--quiet)
opt_silent=:
func_append preserve_args " $opt"
opt_verbose=false
;;
--verbose|-v)
opt_verbose=:
func_append preserve_args " $opt"
opt_silent=false
;;
--tag)
test $# = 0 && func_missing_arg $opt && break
optarg="$1"
opt_tag="$optarg"
func_append preserve_args " $opt $optarg"
func_enable_tag "$optarg"
shift
;;
-\?|-h) func_usage ;;
--help) func_help ;;
--version) func_version ;;
# Separate optargs to long options:
--*=*)
func_split_long_opt "$opt"
set dummy "$func_split_long_opt_name" "$func_split_long_opt_arg" ${1+"$@"}
shift
;;
# Separate non-argument short options:
-\?*|-h*|-n*|-v*)
func_split_short_opt "$opt"
set dummy "$func_split_short_opt_name" "-$func_split_short_opt_arg" ${1+"$@"}
shift
;;
--) break ;;
-*) func_fatal_help "unrecognized option \`$opt'" ;;
*) set dummy "$opt" ${1+"$@"}; shift; break ;;
esac
done
# Validate options:
# save first non-option argument
if test "$#" -gt 0; then
nonopt="$opt"
shift
fi
# preserve --debug
test "$opt_debug" = : || func_append preserve_args " --debug"
case $host in
*cygwin* | *mingw* | *pw32* | *cegcc*)
# don't eliminate duplications in $postdeps and $predeps
opt_duplicate_compiler_generated_deps=:
;;
*)
opt_duplicate_compiler_generated_deps=$opt_preserve_dup_deps
;;
esac
$opt_help || {
# Sanity checks first:
func_check_version_match
if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
func_fatal_configuration "not configured to build any kind of library"
fi
# Darwin sucks
eval std_shrext=\"$shrext_cmds\"
# Only execute mode is allowed to have -dlopen flags.
if test -n "$opt_dlopen" && test "$opt_mode" != execute; then
func_error "unrecognized option \`-dlopen'"
$ECHO "$help" 1>&2
exit $EXIT_FAILURE
fi
# Change the help message to a mode-specific one.
generic_help="$help"
help="Try \`$progname --help --mode=$opt_mode' for more information."
}
# Bail if the options were screwed
$exit_cmd $EXIT_FAILURE
}
## ----------- ##
## Main. ##
## ----------- ##
# func_lalib_p file
# True iff FILE is a libtool `.la' library or `.lo' object file.
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_lalib_p ()
{
test -f "$1" &&
$SED -e 4q "$1" 2>/dev/null \
| $GREP "^# Generated by .*$PACKAGE" > /dev/null 2>&1
}
# func_lalib_unsafe_p file
# True iff FILE is a libtool `.la' library or `.lo' object file.
# This function implements the same check as func_lalib_p without
# resorting to external programs. To this end, it redirects stdin and
# closes it afterwards, without saving the original file descriptor.
# As a safety measure, use it only where a negative result would be
# fatal anyway. Works if `file' does not exist.
func_lalib_unsafe_p ()
{
lalib_p=no
if test -f "$1" && test -r "$1" && exec 5<&0 <"$1"; then
for lalib_p_l in 1 2 3 4
do
read lalib_p_line
case "$lalib_p_line" in
\#\ Generated\ by\ *$PACKAGE* ) lalib_p=yes; break;;
esac
done
exec 0<&5 5<&-
fi
test "$lalib_p" = yes
}
# func_ltwrapper_script_p file
# True iff FILE is a libtool wrapper script
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_script_p ()
{
func_lalib_p "$1"
}
# func_ltwrapper_executable_p file
# True iff FILE is a libtool wrapper executable
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_executable_p ()
{
func_ltwrapper_exec_suffix=
case $1 in
*.exe) ;;
*) func_ltwrapper_exec_suffix=.exe ;;
esac
$GREP "$magic_exe" "$1$func_ltwrapper_exec_suffix" >/dev/null 2>&1
}
# func_ltwrapper_scriptname file
# Assumes file is an ltwrapper_executable
# uses $file to determine the appropriate filename for a
# temporary ltwrapper_script.
func_ltwrapper_scriptname ()
{
func_dirname_and_basename "$1" "" "."
func_stripname '' '.exe' "$func_basename_result"
func_ltwrapper_scriptname_result="$func_dirname_result/$objdir/${func_stripname_result}_ltshwrapper"
}
# func_ltwrapper_p file
# True iff FILE is a libtool wrapper script or wrapper executable
# This function is only a basic sanity check; it will hardly flush out
# determined imposters.
func_ltwrapper_p ()
{
func_ltwrapper_script_p "$1" || func_ltwrapper_executable_p "$1"
}
# func_execute_cmds commands fail_cmd
# Execute tilde-delimited COMMANDS.
# If FAIL_CMD is given, eval that upon failure.
# FAIL_CMD may read-access the current command in variable CMD!
func_execute_cmds ()
{
$opt_debug
save_ifs=$IFS; IFS='~'
for cmd in $1; do
IFS=$save_ifs
eval cmd=\"$cmd\"
func_show_eval "$cmd" "${2-:}"
done
IFS=$save_ifs
}
# func_source file
# Source FILE, adding directory component if necessary.
# Note that it is not necessary on cygwin/mingw to append a dot to
# FILE even if both FILE and FILE.exe exist: automatic-append-.exe
# behavior happens only for exec(3), not for open(2)! Also, sourcing
# `FILE.' does not work on cygwin managed mounts.
func_source ()
{
$opt_debug
case $1 in
*/* | *\\*) . "$1" ;;
*) . "./$1" ;;
esac
}
# func_resolve_sysroot PATH
# Replace a leading = in PATH with a sysroot. Store the result into
# func_resolve_sysroot_result
func_resolve_sysroot ()
{
func_resolve_sysroot_result=$1
case $func_resolve_sysroot_result in
=*)
func_stripname '=' '' "$func_resolve_sysroot_result"
func_resolve_sysroot_result=$lt_sysroot$func_stripname_result
;;
esac
}
# func_replace_sysroot PATH
# If PATH begins with the sysroot, replace it with = and
# store the result into func_replace_sysroot_result.
func_replace_sysroot ()
{
case "$lt_sysroot:$1" in
?*:"$lt_sysroot"*)
func_stripname "$lt_sysroot" '' "$1"
func_replace_sysroot_result="=$func_stripname_result"
;;
*)
# Including no sysroot.
func_replace_sysroot_result=$1
;;
esac
}
# func_infer_tag arg
# Infer tagged configuration to use if any are available and
# if one wasn't chosen via the "--tag" command line option.
# Only attempt this if the compiler in the base compile
# command doesn't match the default compiler.
# arg is usually of the form 'gcc ...'
func_infer_tag ()
{
$opt_debug
if test -n "$available_tags" && test -z "$tagname"; then
CC_quoted=
for arg in $CC; do
func_append_quoted CC_quoted "$arg"
done
CC_expanded=`func_echo_all $CC`
CC_quoted_expanded=`func_echo_all $CC_quoted`
case $@ in
# Blanks in the command may have been stripped by the calling shell,
# but not from the CC environment variable when configure was run.
" $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
" $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*) ;;
# Blanks at the start of $base_compile will cause this to fail
# if we don't check for them as well.
*)
for z in $available_tags; do
if $GREP "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then
# Evaluate the configuration.
eval "`${SED} -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`"
CC_quoted=
for arg in $CC; do
# Double-quote args containing other shell metacharacters.
func_append_quoted CC_quoted "$arg"
done
CC_expanded=`func_echo_all $CC`
CC_quoted_expanded=`func_echo_all $CC_quoted`
case "$@ " in
" $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \
" $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*)
# The compiler in the base compile command matches
# the one in the tagged configuration.
# Assume this is the tagged configuration we want.
tagname=$z
break
;;
esac
fi
done
# If $tagname still isn't set, then no tagged configuration
# was found and let the user know that the "--tag" command
# line option must be used.
if test -z "$tagname"; then
func_echo "unable to infer tagged configuration"
func_fatal_error "specify a tag with \`--tag'"
# else
# func_verbose "using $tagname tagged configuration"
fi
;;
esac
fi
}
# func_write_libtool_object output_name pic_name nonpic_name
# Create a libtool object file (analogous to a ".la" file),
# but don't create it if we're doing a dry run.
func_write_libtool_object ()
{
write_libobj=${1}
if test "$build_libtool_libs" = yes; then
write_lobj=\'${2}\'
else
write_lobj=none
fi
if test "$build_old_libs" = yes; then
write_oldobj=\'${3}\'
else
write_oldobj=none
fi
$opt_dry_run || {
cat >${write_libobj}T </dev/null`
if test "$?" -eq 0 && test -n "${func_convert_core_file_wine_to_w32_tmp}"; then
func_convert_core_file_wine_to_w32_result=`$ECHO "$func_convert_core_file_wine_to_w32_tmp" |
$SED -e "$lt_sed_naive_backslashify"`
else
func_convert_core_file_wine_to_w32_result=
fi
fi
}
# end: func_convert_core_file_wine_to_w32
# func_convert_core_path_wine_to_w32 ARG
# Helper function used by path conversion functions when $build is *nix, and
# $host is mingw, cygwin, or some other w32 environment. Relies on a correctly
# configured wine environment available, with the winepath program in $build's
# $PATH. Assumes ARG has no leading or trailing path separator characters.
#
# ARG is path to be converted from $build format to win32.
# Result is available in $func_convert_core_path_wine_to_w32_result.
# Unconvertible file (directory) names in ARG are skipped; if no directory names
# are convertible, then the result may be empty.
func_convert_core_path_wine_to_w32 ()
{
$opt_debug
# unfortunately, winepath doesn't convert paths, only file names
func_convert_core_path_wine_to_w32_result=""
if test -n "$1"; then
oldIFS=$IFS
IFS=:
for func_convert_core_path_wine_to_w32_f in $1; do
IFS=$oldIFS
func_convert_core_file_wine_to_w32 "$func_convert_core_path_wine_to_w32_f"
if test -n "$func_convert_core_file_wine_to_w32_result" ; then
if test -z "$func_convert_core_path_wine_to_w32_result"; then
func_convert_core_path_wine_to_w32_result="$func_convert_core_file_wine_to_w32_result"
else
func_append func_convert_core_path_wine_to_w32_result ";$func_convert_core_file_wine_to_w32_result"
fi
fi
done
IFS=$oldIFS
fi
}
# end: func_convert_core_path_wine_to_w32
# func_cygpath ARGS...
# Wrapper around calling the cygpath program via LT_CYGPATH. This is used when
# when (1) $build is *nix and Cygwin is hosted via a wine environment; or (2)
# $build is MSYS and $host is Cygwin, or (3) $build is Cygwin. In case (1) or
# (2), returns the Cygwin file name or path in func_cygpath_result (input
# file name or path is assumed to be in w32 format, as previously converted
# from $build's *nix or MSYS format). In case (3), returns the w32 file name
# or path in func_cygpath_result (input file name or path is assumed to be in
# Cygwin format). Returns an empty string on error.
#
# ARGS are passed to cygpath, with the last one being the file name or path to
# be converted.
#
# Specify the absolute *nix (or w32) name to cygpath in the LT_CYGPATH
# environment variable; do not put it in $PATH.
func_cygpath ()
{
$opt_debug
if test -n "$LT_CYGPATH" && test -f "$LT_CYGPATH"; then
func_cygpath_result=`$LT_CYGPATH "$@" 2>/dev/null`
if test "$?" -ne 0; then
# on failure, ensure result is empty
func_cygpath_result=
fi
else
func_cygpath_result=
func_error "LT_CYGPATH is empty or specifies non-existent file: \`$LT_CYGPATH'"
fi
}
#end: func_cygpath
# func_convert_core_msys_to_w32 ARG
# Convert file name or path ARG from MSYS format to w32 format. Return
# result in func_convert_core_msys_to_w32_result.
func_convert_core_msys_to_w32 ()
{
$opt_debug
# awkward: cmd appends spaces to result
func_convert_core_msys_to_w32_result=`( cmd //c echo "$1" ) 2>/dev/null |
$SED -e 's/[ ]*$//' -e "$lt_sed_naive_backslashify"`
}
#end: func_convert_core_msys_to_w32
# func_convert_file_check ARG1 ARG2
# Verify that ARG1 (a file name in $build format) was converted to $host
# format in ARG2. Otherwise, emit an error message, but continue (resetting
# func_to_host_file_result to ARG1).
func_convert_file_check ()
{
$opt_debug
if test -z "$2" && test -n "$1" ; then
func_error "Could not determine host file name corresponding to"
func_error " \`$1'"
func_error "Continuing, but uninstalled executables may not work."
# Fallback:
func_to_host_file_result="$1"
fi
}
# end func_convert_file_check
# func_convert_path_check FROM_PATHSEP TO_PATHSEP FROM_PATH TO_PATH
# Verify that FROM_PATH (a path in $build format) was converted to $host
# format in TO_PATH. Otherwise, emit an error message, but continue, resetting
# func_to_host_file_result to a simplistic fallback value (see below).
func_convert_path_check ()
{
$opt_debug
if test -z "$4" && test -n "$3"; then
func_error "Could not determine the host path corresponding to"
func_error " \`$3'"
func_error "Continuing, but uninstalled executables may not work."
# Fallback. This is a deliberately simplistic "conversion" and
# should not be "improved". See libtool.info.
if test "x$1" != "x$2"; then
lt_replace_pathsep_chars="s|$1|$2|g"
func_to_host_path_result=`echo "$3" |
$SED -e "$lt_replace_pathsep_chars"`
else
func_to_host_path_result="$3"
fi
fi
}
# end func_convert_path_check
# func_convert_path_front_back_pathsep FRONTPAT BACKPAT REPL ORIG
# Modifies func_to_host_path_result by prepending REPL if ORIG matches FRONTPAT
# and appending REPL if ORIG matches BACKPAT.
func_convert_path_front_back_pathsep ()
{
$opt_debug
case $4 in
$1 ) func_to_host_path_result="$3$func_to_host_path_result"
;;
esac
case $4 in
$2 ) func_append func_to_host_path_result "$3"
;;
esac
}
# end func_convert_path_front_back_pathsep
##################################################
# $build to $host FILE NAME CONVERSION FUNCTIONS #
##################################################
# invoked via `$to_host_file_cmd ARG'
#
# In each case, ARG is the path to be converted from $build to $host format.
# Result will be available in $func_to_host_file_result.
# func_to_host_file ARG
# Converts the file name ARG from $build format to $host format. Return result
# in func_to_host_file_result.
func_to_host_file ()
{
$opt_debug
$to_host_file_cmd "$1"
}
# end func_to_host_file
# func_to_tool_file ARG LAZY
# converts the file name ARG from $build format to toolchain format. Return
# result in func_to_tool_file_result. If the conversion in use is listed
# in (the comma separated) LAZY, no conversion takes place.
func_to_tool_file ()
{
$opt_debug
case ,$2, in
*,"$to_tool_file_cmd",*)
func_to_tool_file_result=$1
;;
*)
$to_tool_file_cmd "$1"
func_to_tool_file_result=$func_to_host_file_result
;;
esac
}
# end func_to_tool_file
# func_convert_file_noop ARG
# Copy ARG to func_to_host_file_result.
func_convert_file_noop ()
{
func_to_host_file_result="$1"
}
# end func_convert_file_noop
# func_convert_file_msys_to_w32 ARG
# Convert file name ARG from (mingw) MSYS to (mingw) w32 format; automatic
# conversion to w32 is not available inside the cwrapper. Returns result in
# func_to_host_file_result.
func_convert_file_msys_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_msys_to_w32 "$1"
func_to_host_file_result="$func_convert_core_msys_to_w32_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_msys_to_w32
# func_convert_file_cygwin_to_w32 ARG
# Convert file name ARG from Cygwin to w32 format. Returns result in
# func_to_host_file_result.
func_convert_file_cygwin_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
# because $build is cygwin, we call "the" cygpath in $PATH; no need to use
# LT_CYGPATH in this case.
func_to_host_file_result=`cygpath -m "$1"`
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_cygwin_to_w32
# func_convert_file_nix_to_w32 ARG
# Convert file name ARG from *nix to w32 format. Requires a wine environment
# and a working winepath. Returns result in func_to_host_file_result.
func_convert_file_nix_to_w32 ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_file_wine_to_w32 "$1"
func_to_host_file_result="$func_convert_core_file_wine_to_w32_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_nix_to_w32
# func_convert_file_msys_to_cygwin ARG
# Convert file name ARG from MSYS to Cygwin format. Requires LT_CYGPATH set.
# Returns result in func_to_host_file_result.
func_convert_file_msys_to_cygwin ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
func_convert_core_msys_to_w32 "$1"
func_cygpath -u "$func_convert_core_msys_to_w32_result"
func_to_host_file_result="$func_cygpath_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_msys_to_cygwin
# func_convert_file_nix_to_cygwin ARG
# Convert file name ARG from *nix to Cygwin format. Requires Cygwin installed
# in a wine environment, working winepath, and LT_CYGPATH set. Returns result
# in func_to_host_file_result.
func_convert_file_nix_to_cygwin ()
{
$opt_debug
func_to_host_file_result="$1"
if test -n "$1"; then
# convert from *nix to w32, then use cygpath to convert from w32 to cygwin.
func_convert_core_file_wine_to_w32 "$1"
func_cygpath -u "$func_convert_core_file_wine_to_w32_result"
func_to_host_file_result="$func_cygpath_result"
fi
func_convert_file_check "$1" "$func_to_host_file_result"
}
# end func_convert_file_nix_to_cygwin
#############################################
# $build to $host PATH CONVERSION FUNCTIONS #
#############################################
# invoked via `$to_host_path_cmd ARG'
#
# In each case, ARG is the path to be converted from $build to $host format.
# The result will be available in $func_to_host_path_result.
#
# Path separators are also converted from $build format to $host format. If
# ARG begins or ends with a path separator character, it is preserved (but
# converted to $host format) on output.
#
# All path conversion functions are named using the following convention:
# file name conversion function : func_convert_file_X_to_Y ()
# path conversion function : func_convert_path_X_to_Y ()
# where, for any given $build/$host combination the 'X_to_Y' value is the
# same. If conversion functions are added for new $build/$host combinations,
# the two new functions must follow this pattern, or func_init_to_host_path_cmd
# will break.
# func_init_to_host_path_cmd
# Ensures that function "pointer" variable $to_host_path_cmd is set to the
# appropriate value, based on the value of $to_host_file_cmd.
to_host_path_cmd=
func_init_to_host_path_cmd ()
{
$opt_debug
if test -z "$to_host_path_cmd"; then
func_stripname 'func_convert_file_' '' "$to_host_file_cmd"
to_host_path_cmd="func_convert_path_${func_stripname_result}"
fi
}
# func_to_host_path ARG
# Converts the path ARG from $build format to $host format. Return result
# in func_to_host_path_result.
func_to_host_path ()
{
$opt_debug
func_init_to_host_path_cmd
$to_host_path_cmd "$1"
}
# end func_to_host_path
# func_convert_path_noop ARG
# Copy ARG to func_to_host_path_result.
func_convert_path_noop ()
{
func_to_host_path_result="$1"
}
# end func_convert_path_noop
# func_convert_path_msys_to_w32 ARG
# Convert path ARG from (mingw) MSYS to (mingw) w32 format; automatic
# conversion to w32 is not available inside the cwrapper. Returns result in
# func_to_host_path_result.
func_convert_path_msys_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# Remove leading and trailing path separator characters from ARG. MSYS
# behavior is inconsistent here; cygpath turns them into '.;' and ';.';
# and winepath ignores them completely.
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
func_to_host_path_result="$func_convert_core_msys_to_w32_result"
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_msys_to_w32
# func_convert_path_cygwin_to_w32 ARG
# Convert path ARG from Cygwin to w32 format. Returns result in
# func_to_host_file_result.
func_convert_path_cygwin_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_to_host_path_result=`cygpath -m -p "$func_to_host_path_tmp1"`
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_cygwin_to_w32
# func_convert_path_nix_to_w32 ARG
# Convert path ARG from *nix to w32 format. Requires a wine environment and
# a working winepath. Returns result in func_to_host_file_result.
func_convert_path_nix_to_w32 ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
func_to_host_path_result="$func_convert_core_path_wine_to_w32_result"
func_convert_path_check : ";" \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" ";" "$1"
fi
}
# end func_convert_path_nix_to_w32
# func_convert_path_msys_to_cygwin ARG
# Convert path ARG from MSYS to Cygwin format. Requires LT_CYGPATH set.
# Returns result in func_to_host_file_result.
func_convert_path_msys_to_cygwin ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# See func_convert_path_msys_to_w32:
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_msys_to_w32 "$func_to_host_path_tmp1"
func_cygpath -u -p "$func_convert_core_msys_to_w32_result"
func_to_host_path_result="$func_cygpath_result"
func_convert_path_check : : \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" : "$1"
fi
}
# end func_convert_path_msys_to_cygwin
# func_convert_path_nix_to_cygwin ARG
# Convert path ARG from *nix to Cygwin format. Requires Cygwin installed in a
# a wine environment, working winepath, and LT_CYGPATH set. Returns result in
# func_to_host_file_result.
func_convert_path_nix_to_cygwin ()
{
$opt_debug
func_to_host_path_result="$1"
if test -n "$1"; then
# Remove leading and trailing path separator characters from
# ARG. msys behavior is inconsistent here, cygpath turns them
# into '.;' and ';.', and winepath ignores them completely.
func_stripname : : "$1"
func_to_host_path_tmp1=$func_stripname_result
func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1"
func_cygpath -u -p "$func_convert_core_path_wine_to_w32_result"
func_to_host_path_result="$func_cygpath_result"
func_convert_path_check : : \
"$func_to_host_path_tmp1" "$func_to_host_path_result"
func_convert_path_front_back_pathsep ":*" "*:" : "$1"
fi
}
# end func_convert_path_nix_to_cygwin
# func_mode_compile arg...
func_mode_compile ()
{
$opt_debug
# Get the compilation command and the source file.
base_compile=
srcfile="$nonopt" # always keep a non-empty value in "srcfile"
suppress_opt=yes
suppress_output=
arg_mode=normal
libobj=
later=
pie_flag=
for arg
do
case $arg_mode in
arg )
# do not "continue". Instead, add this to base_compile
lastarg="$arg"
arg_mode=normal
;;
target )
libobj="$arg"
arg_mode=normal
continue
;;
normal )
# Accept any command-line options.
case $arg in
-o)
test -n "$libobj" && \
func_fatal_error "you cannot specify \`-o' more than once"
arg_mode=target
continue
;;
-pie | -fpie | -fPIE)
func_append pie_flag " $arg"
continue
;;
-shared | -static | -prefer-pic | -prefer-non-pic)
func_append later " $arg"
continue
;;
-no-suppress)
suppress_opt=no
continue
;;
-Xcompiler)
arg_mode=arg # the next one goes into the "base_compile" arg list
continue # The current "srcfile" will either be retained or
;; # replaced later. I would guess that would be a bug.
-Wc,*)
func_stripname '-Wc,' '' "$arg"
args=$func_stripname_result
lastarg=
save_ifs="$IFS"; IFS=','
for arg in $args; do
IFS="$save_ifs"
func_append_quoted lastarg "$arg"
done
IFS="$save_ifs"
func_stripname ' ' '' "$lastarg"
lastarg=$func_stripname_result
# Add the arguments to base_compile.
func_append base_compile " $lastarg"
continue
;;
*)
# Accept the current argument as the source file.
# The previous "srcfile" becomes the current argument.
#
lastarg="$srcfile"
srcfile="$arg"
;;
esac # case $arg
;;
esac # case $arg_mode
# Aesthetically quote the previous argument.
func_append_quoted base_compile "$lastarg"
done # for arg
case $arg_mode in
arg)
func_fatal_error "you must specify an argument for -Xcompile"
;;
target)
func_fatal_error "you must specify a target with \`-o'"
;;
*)
# Get the name of the library object.
test -z "$libobj" && {
func_basename "$srcfile"
libobj="$func_basename_result"
}
;;
esac
# Recognize several different file suffixes.
# If the user specifies -o file.o, it is replaced with file.lo
case $libobj in
*.[cCFSifmso] | \
*.ada | *.adb | *.ads | *.asm | \
*.c++ | *.cc | *.ii | *.class | *.cpp | *.cxx | \
*.[fF][09]? | *.for | *.java | *.go | *.obj | *.sx | *.cu | *.cup)
func_xform "$libobj"
libobj=$func_xform_result
;;
esac
case $libobj in
*.lo) func_lo2o "$libobj"; obj=$func_lo2o_result ;;
*)
func_fatal_error "cannot determine name of library object from \`$libobj'"
;;
esac
func_infer_tag $base_compile
for arg in $later; do
case $arg in
-shared)
test "$build_libtool_libs" != yes && \
func_fatal_configuration "can not build a shared library"
build_old_libs=no
continue
;;
-static)
build_libtool_libs=no
build_old_libs=yes
continue
;;
-prefer-pic)
pic_mode=yes
continue
;;
-prefer-non-pic)
pic_mode=no
continue
;;
esac
done
func_quote_for_eval "$libobj"
test "X$libobj" != "X$func_quote_for_eval_result" \
&& $ECHO "X$libobj" | $GREP '[]~#^*{};<>?"'"'"' &()|`$[]' \
&& func_warning "libobj name \`$libobj' may not contain shell special characters."
func_dirname_and_basename "$obj" "/" ""
objname="$func_basename_result"
xdir="$func_dirname_result"
lobj=${xdir}$objdir/$objname
test -z "$base_compile" && \
func_fatal_help "you must specify a compilation command"
# Delete any leftover library objects.
if test "$build_old_libs" = yes; then
removelist="$obj $lobj $libobj ${libobj}T"
else
removelist="$lobj $libobj ${libobj}T"
fi
# On Cygwin there's no "real" PIC flag so we must build both object types
case $host_os in
cygwin* | mingw* | pw32* | os2* | cegcc*)
pic_mode=default
;;
esac
if test "$pic_mode" = no && test "$deplibs_check_method" != pass_all; then
# non-PIC code in shared libraries is not supported
pic_mode=default
fi
# Calculate the filename of the output object if compiler does
# not support -o with -c
if test "$compiler_c_o" = no; then
output_obj=`$ECHO "$srcfile" | $SED 's%^.*/%%; s%\.[^.]*$%%'`.${objext}
lockfile="$output_obj.lock"
else
output_obj=
need_locks=no
lockfile=
fi
# Lock this critical section if it is needed
# We use this script file to make the link, it avoids creating a new file
if test "$need_locks" = yes; then
until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
func_echo "Waiting for $lockfile to be removed"
sleep 2
done
elif test "$need_locks" = warn; then
if test -f "$lockfile"; then
$ECHO "\
*** ERROR, $lockfile exists and contains:
`cat $lockfile 2>/dev/null`
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
func_append removelist " $output_obj"
$ECHO "$srcfile" > "$lockfile"
fi
$opt_dry_run || $RM $removelist
func_append removelist " $lockfile"
trap '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' 1 2 15
func_to_tool_file "$srcfile" func_convert_file_msys_to_w32
srcfile=$func_to_tool_file_result
func_quote_for_eval "$srcfile"
qsrcfile=$func_quote_for_eval_result
# Only build a PIC object if we are building libtool libraries.
if test "$build_libtool_libs" = yes; then
# Without this assignment, base_compile gets emptied.
fbsd_hideous_sh_bug=$base_compile
if test "$pic_mode" != no; then
command="$base_compile $qsrcfile $pic_flag"
else
# Don't build PIC code
command="$base_compile $qsrcfile"
fi
func_mkdir_p "$xdir$objdir"
if test -z "$output_obj"; then
# Place PIC objects in $objdir
func_append command " -o $lobj"
fi
func_show_eval_locale "$command" \
'test -n "$output_obj" && $RM $removelist; exit $EXIT_FAILURE'
if test "$need_locks" = warn &&
test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
$ECHO "\
*** ERROR, $lockfile contains:
`cat $lockfile 2>/dev/null`
but it should contain:
$srcfile
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
# Just move the object if needed, then go on to compile the next one
if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then
func_show_eval '$MV "$output_obj" "$lobj"' \
'error=$?; $opt_dry_run || $RM $removelist; exit $error'
fi
# Allow error messages only from the first compilation.
if test "$suppress_opt" = yes; then
suppress_output=' >/dev/null 2>&1'
fi
fi
# Only build a position-dependent object if we build old libraries.
if test "$build_old_libs" = yes; then
if test "$pic_mode" != yes; then
# Don't build PIC code
command="$base_compile $qsrcfile$pie_flag"
else
command="$base_compile $qsrcfile $pic_flag"
fi
if test "$compiler_c_o" = yes; then
func_append command " -o $obj"
fi
# Suppress compiler output if we already did a PIC compilation.
func_append command "$suppress_output"
func_show_eval_locale "$command" \
'$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE'
if test "$need_locks" = warn &&
test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then
$ECHO "\
*** ERROR, $lockfile contains:
`cat $lockfile 2>/dev/null`
but it should contain:
$srcfile
This indicates that another process is trying to use the same
temporary object file, and libtool could not work around it because
your compiler does not support \`-c' and \`-o' together. If you
repeat this compilation, it may succeed, by chance, but you had better
avoid parallel builds (make -j) in this platform, or get a better
compiler."
$opt_dry_run || $RM $removelist
exit $EXIT_FAILURE
fi
# Just move the object if needed
if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then
func_show_eval '$MV "$output_obj" "$obj"' \
'error=$?; $opt_dry_run || $RM $removelist; exit $error'
fi
fi
$opt_dry_run || {
func_write_libtool_object "$libobj" "$objdir/$objname" "$objname"
# Unlock the critical section if it was locked
if test "$need_locks" != no; then
removelist=$lockfile
$RM "$lockfile"
fi
}
exit $EXIT_SUCCESS
}
$opt_help || {
test "$opt_mode" = compile && func_mode_compile ${1+"$@"}
}
func_mode_help ()
{
# We need to display help for each of the modes.
case $opt_mode in
"")
# Generic help is extracted from the usage comments
# at the start of this file.
func_help
;;
clean)
$ECHO \
"Usage: $progname [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
Remove files from the build directory.
RM is the name of the program to use to delete files associated with each FILE
(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
to RM.
If FILE is a libtool library, object or program, all the files associated
with it are deleted. Otherwise, only FILE itself is deleted using RM."
;;
compile)
$ECHO \
"Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
Compile a source file into a libtool library object.
This mode accepts the following additional options:
-o OUTPUT-FILE set the output file name to OUTPUT-FILE
-no-suppress do not suppress compiler output for multiple passes
-prefer-pic try to build PIC objects only
-prefer-non-pic try to build non-PIC objects only
-shared do not build a \`.o' file suitable for static linking
-static only build a \`.o' file suitable for static linking
-Wc,FLAG pass FLAG directly to the compiler
COMPILE-COMMAND is a command to be used in creating a \`standard' object file
from the given SOURCEFILE.
The output file name is determined by removing the directory component from
SOURCEFILE, then substituting the C source code suffix \`.c' with the
library object suffix, \`.lo'."
;;
execute)
$ECHO \
"Usage: $progname [OPTION]... --mode=execute COMMAND [ARGS]...
Automatically set library path, then run a program.
This mode accepts the following additional options:
-dlopen FILE add the directory containing FILE to the library path
This mode sets the library path environment variable according to \`-dlopen'
flags.
If any of the ARGS are libtool executable wrappers, then they are translated
into their corresponding uninstalled binary, and any of their required library
directories are added to the library path.
Then, COMMAND is executed, with ARGS as arguments."
;;
finish)
$ECHO \
"Usage: $progname [OPTION]... --mode=finish [LIBDIR]...
Complete the installation of libtool libraries.
Each LIBDIR is a directory that contains libtool libraries.
The commands that this mode executes may require superuser privileges. Use
the \`--dry-run' option if you just want to see what would be executed."
;;
install)
$ECHO \
"Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND...
Install executables or libraries.
INSTALL-COMMAND is the installation command. The first component should be
either the \`install' or \`cp' program.
The following components of INSTALL-COMMAND are treated specially:
-inst-prefix-dir PREFIX-DIR Use PREFIX-DIR as a staging area for installation
The rest of the components are interpreted as arguments to that command (only
BSD-compatible install options are recognized)."
;;
link)
$ECHO \
"Usage: $progname [OPTION]... --mode=link LINK-COMMAND...
Link object files or libraries together to form another library, or to
create an executable program.
LINK-COMMAND is a command using the C compiler that you would use to create
a program from several object files.
The following components of LINK-COMMAND are treated specially:
-all-static do not do any dynamic linking at all
-avoid-version do not add a version suffix if possible
-bindir BINDIR specify path to binaries directory (for systems where
libraries must be found in the PATH setting at runtime)
-dlopen FILE \`-dlpreopen' FILE if it cannot be dlopened at runtime
-dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols
-export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
-export-symbols SYMFILE
try to export only the symbols listed in SYMFILE
-export-symbols-regex REGEX
try to export only the symbols matching REGEX
-LLIBDIR search LIBDIR for required installed libraries
-lNAME OUTPUT-FILE requires the installed library libNAME
-module build a library that can dlopened
-no-fast-install disable the fast-install mode
-no-install link a not-installable executable
-no-undefined declare that a library does not refer to external symbols
-o OUTPUT-FILE create OUTPUT-FILE from the specified objects
-objectlist FILE Use a list of object files found in FILE to specify objects
-precious-files-regex REGEX
don't remove output files matching REGEX
-release RELEASE specify package release information
-rpath LIBDIR the created library will eventually be installed in LIBDIR
-R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries
-shared only do dynamic linking of libtool libraries
-shrext SUFFIX override the standard shared library file extension
-static do not do any dynamic linking of uninstalled libtool libraries
-static-libtool-libs
do not do any dynamic linking of libtool libraries
-version-info CURRENT[:REVISION[:AGE]]
specify library version info [each variable defaults to 0]
-weak LIBNAME declare that the target provides the LIBNAME interface
-Wc,FLAG
-Xcompiler FLAG pass linker-specific FLAG directly to the compiler
-Wl,FLAG
-Xlinker FLAG pass linker-specific FLAG directly to the linker
-XCClinker FLAG pass link-specific FLAG to the compiler driver (CC)
All other options (arguments beginning with \`-') are ignored.
Every other argument is treated as a filename. Files ending in \`.la' are
treated as uninstalled libtool libraries, other files are standard or library
object files.
If the OUTPUT-FILE ends in \`.la', then a libtool library is created,
only library objects (\`.lo' files) may be specified, and \`-rpath' is
required, except when creating a convenience library.
If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
using \`ar' and \`ranlib', or on Windows using \`lib'.
If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file
is created, otherwise an executable program is created."
;;
uninstall)
$ECHO \
"Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
Remove libraries from an installation directory.
RM is the name of the program to use to delete files associated with each FILE
(typically \`/bin/rm'). RM-OPTIONS are options (such as \`-f') to be passed
to RM.
If FILE is a libtool library, all the files associated with it are deleted.
Otherwise, only FILE itself is deleted using RM."
;;
*)
func_fatal_help "invalid operation mode \`$opt_mode'"
;;
esac
echo
$ECHO "Try \`$progname --help' for more information about other modes."
}
# Now that we've collected a possible --mode arg, show help if necessary
if $opt_help; then
if test "$opt_help" = :; then
func_mode_help
else
{
func_help noexit
for opt_mode in compile link execute install finish uninstall clean; do
func_mode_help
done
} | sed -n '1p; 2,$s/^Usage:/ or: /p'
{
func_help noexit
for opt_mode in compile link execute install finish uninstall clean; do
echo
func_mode_help
done
} |
sed '1d
/^When reporting/,/^Report/{
H
d
}
$x
/information about other modes/d
/more detailed .*MODE/d
s/^Usage:.*--mode=\([^ ]*\) .*/Description of \1 mode:/'
fi
exit $?
fi
# func_mode_execute arg...
func_mode_execute ()
{
$opt_debug
# The first argument is the command name.
cmd="$nonopt"
test -z "$cmd" && \
func_fatal_help "you must specify a COMMAND"
# Handle -dlopen flags immediately.
for file in $opt_dlopen; do
test -f "$file" \
|| func_fatal_help "\`$file' is not a file"
dir=
case $file in
*.la)
func_resolve_sysroot "$file"
file=$func_resolve_sysroot_result
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$file" \
|| func_fatal_help "\`$lib' is not a valid libtool archive"
# Read the libtool library.
dlname=
library_names=
func_source "$file"
# Skip this library if it cannot be dlopened.
if test -z "$dlname"; then
# Warn if it was a shared library.
test -n "$library_names" && \
func_warning "\`$file' was not linked with \`-export-dynamic'"
continue
fi
func_dirname "$file" "" "."
dir="$func_dirname_result"
if test -f "$dir/$objdir/$dlname"; then
func_append dir "/$objdir"
else
if test ! -f "$dir/$dlname"; then
func_fatal_error "cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'"
fi
fi
;;
*.lo)
# Just add the directory containing the .lo file.
func_dirname "$file" "" "."
dir="$func_dirname_result"
;;
*)
func_warning "\`-dlopen' is ignored for non-libtool libraries and objects"
continue
;;
esac
# Get the absolute pathname.
absdir=`cd "$dir" && pwd`
test -n "$absdir" && dir="$absdir"
# Now add the directory to shlibpath_var.
if eval "test -z \"\$$shlibpath_var\""; then
eval "$shlibpath_var=\"\$dir\""
else
eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
fi
done
# This variable tells wrapper scripts just to set shlibpath_var
# rather than running their programs.
libtool_execute_magic="$magic"
# Check if any of the arguments is a wrapper script.
args=
for file
do
case $file in
-* | *.la | *.lo ) ;;
*)
# Do a test to see if this is really a libtool program.
if func_ltwrapper_script_p "$file"; then
func_source "$file"
# Transform arg to wrapped name.
file="$progdir/$program"
elif func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
func_source "$func_ltwrapper_scriptname_result"
# Transform arg to wrapped name.
file="$progdir/$program"
fi
;;
esac
# Quote arguments (to preserve shell metacharacters).
func_append_quoted args "$file"
done
if test "X$opt_dry_run" = Xfalse; then
if test -n "$shlibpath_var"; then
# Export the shlibpath_var.
eval "export $shlibpath_var"
fi
# Restore saved environment variables
for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES
do
eval "if test \"\${save_$lt_var+set}\" = set; then
$lt_var=\$save_$lt_var; export $lt_var
else
$lt_unset $lt_var
fi"
done
# Now prepare to actually exec the command.
exec_cmd="\$cmd$args"
else
# Display what would be done.
if test -n "$shlibpath_var"; then
eval "\$ECHO \"\$shlibpath_var=\$$shlibpath_var\""
echo "export $shlibpath_var"
fi
$ECHO "$cmd$args"
exit $EXIT_SUCCESS
fi
}
test "$opt_mode" = execute && func_mode_execute ${1+"$@"}
# func_mode_finish arg...
func_mode_finish ()
{
$opt_debug
libs=
libdirs=
admincmds=
for opt in "$nonopt" ${1+"$@"}
do
if test -d "$opt"; then
func_append libdirs " $opt"
elif test -f "$opt"; then
if func_lalib_unsafe_p "$opt"; then
func_append libs " $opt"
else
func_warning "\`$opt' is not a valid libtool archive"
fi
else
func_fatal_error "invalid argument \`$opt'"
fi
done
if test -n "$libs"; then
if test -n "$lt_sysroot"; then
sysroot_regex=`$ECHO "$lt_sysroot" | $SED "$sed_make_literal_regex"`
sysroot_cmd="s/\([ ']\)$sysroot_regex/\1/g;"
else
sysroot_cmd=
fi
# Remove sysroot references
if $opt_dry_run; then
for lib in $libs; do
echo "removing references to $lt_sysroot and \`=' prefixes from $lib"
done
else
tmpdir=`func_mktempdir`
for lib in $libs; do
sed -e "${sysroot_cmd} s/\([ ']-[LR]\)=/\1/g; s/\([ ']\)=/\1/g" $lib \
> $tmpdir/tmp-la
mv -f $tmpdir/tmp-la $lib
done
${RM}r "$tmpdir"
fi
fi
if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
for libdir in $libdirs; do
if test -n "$finish_cmds"; then
# Do each command in the finish commands.
func_execute_cmds "$finish_cmds" 'admincmds="$admincmds
'"$cmd"'"'
fi
if test -n "$finish_eval"; then
# Do the single finish_eval.
eval cmds=\"$finish_eval\"
$opt_dry_run || eval "$cmds" || func_append admincmds "
$cmds"
fi
done
fi
# Exit here if they wanted silent mode.
$opt_silent && exit $EXIT_SUCCESS
if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
echo "----------------------------------------------------------------------"
echo "Libraries have been installed in:"
for libdir in $libdirs; do
$ECHO " $libdir"
done
echo
echo "If you ever happen to want to link against installed libraries"
echo "in a given directory, LIBDIR, you must either use libtool, and"
echo "specify the full pathname of the library, or use the \`-LLIBDIR'"
echo "flag during linking and do at least one of the following:"
if test -n "$shlibpath_var"; then
echo " - add LIBDIR to the \`$shlibpath_var' environment variable"
echo " during execution"
fi
if test -n "$runpath_var"; then
echo " - add LIBDIR to the \`$runpath_var' environment variable"
echo " during linking"
fi
if test -n "$hardcode_libdir_flag_spec"; then
libdir=LIBDIR
eval flag=\"$hardcode_libdir_flag_spec\"
$ECHO " - use the \`$flag' linker flag"
fi
if test -n "$admincmds"; then
$ECHO " - have your system administrator run these commands:$admincmds"
fi
if test -f /etc/ld.so.conf; then
echo " - have your system administrator add LIBDIR to \`/etc/ld.so.conf'"
fi
echo
echo "See any operating system documentation about shared libraries for"
case $host in
solaris2.[6789]|solaris2.1[0-9])
echo "more information, such as the ld(1), crle(1) and ld.so(8) manual"
echo "pages."
;;
*)
echo "more information, such as the ld(1) and ld.so(8) manual pages."
;;
esac
echo "----------------------------------------------------------------------"
fi
exit $EXIT_SUCCESS
}
test "$opt_mode" = finish && func_mode_finish ${1+"$@"}
# func_mode_install arg...
func_mode_install ()
{
$opt_debug
# There may be an optional sh(1) argument at the beginning of
# install_prog (especially on Windows NT).
if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh ||
# Allow the use of GNU shtool's install command.
case $nonopt in *shtool*) :;; *) false;; esac; then
# Aesthetically quote it.
func_quote_for_eval "$nonopt"
install_prog="$func_quote_for_eval_result "
arg=$1
shift
else
install_prog=
arg=$nonopt
fi
# The real first argument should be the name of the installation program.
# Aesthetically quote it.
func_quote_for_eval "$arg"
func_append install_prog "$func_quote_for_eval_result"
install_shared_prog=$install_prog
case " $install_prog " in
*[\\\ /]cp\ *) install_cp=: ;;
*) install_cp=false ;;
esac
# We need to accept at least all the BSD install flags.
dest=
files=
opts=
prev=
install_type=
isdir=no
stripme=
no_mode=:
for arg
do
arg2=
if test -n "$dest"; then
func_append files " $dest"
dest=$arg
continue
fi
case $arg in
-d) isdir=yes ;;
-f)
if $install_cp; then :; else
prev=$arg
fi
;;
-g | -m | -o)
prev=$arg
;;
-s)
stripme=" -s"
continue
;;
-*)
;;
*)
# If the previous option needed an argument, then skip it.
if test -n "$prev"; then
if test "x$prev" = x-m && test -n "$install_override_mode"; then
arg2=$install_override_mode
no_mode=false
fi
prev=
else
dest=$arg
continue
fi
;;
esac
# Aesthetically quote the argument.
func_quote_for_eval "$arg"
func_append install_prog " $func_quote_for_eval_result"
if test -n "$arg2"; then
func_quote_for_eval "$arg2"
fi
func_append install_shared_prog " $func_quote_for_eval_result"
done
test -z "$install_prog" && \
func_fatal_help "you must specify an install program"
test -n "$prev" && \
func_fatal_help "the \`$prev' option requires an argument"
if test -n "$install_override_mode" && $no_mode; then
if $install_cp; then :; else
func_quote_for_eval "$install_override_mode"
func_append install_shared_prog " -m $func_quote_for_eval_result"
fi
fi
if test -z "$files"; then
if test -z "$dest"; then
func_fatal_help "no file or destination specified"
else
func_fatal_help "you must specify a destination"
fi
fi
# Strip any trailing slash from the destination.
func_stripname '' '/' "$dest"
dest=$func_stripname_result
# Check to see that the destination is a directory.
test -d "$dest" && isdir=yes
if test "$isdir" = yes; then
destdir="$dest"
destname=
else
func_dirname_and_basename "$dest" "" "."
destdir="$func_dirname_result"
destname="$func_basename_result"
# Not a directory, so check to see that there is only one file specified.
set dummy $files; shift
test "$#" -gt 1 && \
func_fatal_help "\`$dest' is not a directory"
fi
case $destdir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
for file in $files; do
case $file in
*.lo) ;;
*)
func_fatal_help "\`$destdir' must be an absolute directory name"
;;
esac
done
;;
esac
# This variable tells wrapper scripts just to set variables rather
# than running their programs.
libtool_install_magic="$magic"
staticlibs=
future_libdirs=
current_libdirs=
for file in $files; do
# Do each installation.
case $file in
*.$libext)
# Do the static libraries later.
func_append staticlibs " $file"
;;
*.la)
func_resolve_sysroot "$file"
file=$func_resolve_sysroot_result
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$file" \
|| func_fatal_help "\`$file' is not a valid libtool archive"
library_names=
old_library=
relink_command=
func_source "$file"
# Add the libdir to current_libdirs if it is the destination.
if test "X$destdir" = "X$libdir"; then
case "$current_libdirs " in
*" $libdir "*) ;;
*) func_append current_libdirs " $libdir" ;;
esac
else
# Note the libdir as a future libdir.
case "$future_libdirs " in
*" $libdir "*) ;;
*) func_append future_libdirs " $libdir" ;;
esac
fi
func_dirname "$file" "/" ""
dir="$func_dirname_result"
func_append dir "$objdir"
if test -n "$relink_command"; then
# Determine the prefix the user has applied to our future dir.
inst_prefix_dir=`$ECHO "$destdir" | $SED -e "s%$libdir\$%%"`
# Don't allow the user to place us outside of our expected
# location b/c this prevents finding dependent libraries that
# are installed to the same prefix.
# At present, this check doesn't affect windows .dll's that
# are installed into $libdir/../bin (currently, that works fine)
# but it's something to keep an eye on.
test "$inst_prefix_dir" = "$destdir" && \
func_fatal_error "error: cannot install \`$file' to a directory not ending in $libdir"
if test -n "$inst_prefix_dir"; then
# Stick the inst_prefix_dir data into the link command.
relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"`
else
relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%%"`
fi
func_warning "relinking \`$file'"
func_show_eval "$relink_command" \
'func_fatal_error "error: relink \`$file'\'' with the above command before installing it"'
fi
# See the names of the shared library.
set dummy $library_names; shift
if test -n "$1"; then
realname="$1"
shift
srcname="$realname"
test -n "$relink_command" && srcname="$realname"T
# Install the shared library and build the symlinks.
func_show_eval "$install_shared_prog $dir/$srcname $destdir/$realname" \
'exit $?'
tstripme="$stripme"
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
case $realname in
*.dll.a)
tstripme=""
;;
esac
;;
esac
if test -n "$tstripme" && test -n "$striplib"; then
func_show_eval "$striplib $destdir/$realname" 'exit $?'
fi
if test "$#" -gt 0; then
# Delete the old symlinks, and create new ones.
# Try `ln -sf' first, because the `ln' binary might depend on
# the symlink we replace! Solaris /bin/ln does not understand -f,
# so we also need to try rm && ln -s.
for linkname
do
test "$linkname" != "$realname" \
&& func_show_eval "(cd $destdir && { $LN_S -f $realname $linkname || { $RM $linkname && $LN_S $realname $linkname; }; })"
done
fi
# Do each command in the postinstall commands.
lib="$destdir/$realname"
func_execute_cmds "$postinstall_cmds" 'exit $?'
fi
# Install the pseudo-library for information purposes.
func_basename "$file"
name="$func_basename_result"
instname="$dir/$name"i
func_show_eval "$install_prog $instname $destdir/$name" 'exit $?'
# Maybe install the static library, too.
test -n "$old_library" && func_append staticlibs " $dir/$old_library"
;;
*.lo)
# Install (i.e. copy) a libtool object.
# Figure out destination file name, if it wasn't already specified.
if test -n "$destname"; then
destfile="$destdir/$destname"
else
func_basename "$file"
destfile="$func_basename_result"
destfile="$destdir/$destfile"
fi
# Deduce the name of the destination old-style object file.
case $destfile in
*.lo)
func_lo2o "$destfile"
staticdest=$func_lo2o_result
;;
*.$objext)
staticdest="$destfile"
destfile=
;;
*)
func_fatal_help "cannot copy a libtool object to \`$destfile'"
;;
esac
# Install the libtool object if requested.
test -n "$destfile" && \
func_show_eval "$install_prog $file $destfile" 'exit $?'
# Install the old object if enabled.
if test "$build_old_libs" = yes; then
# Deduce the name of the old-style object file.
func_lo2o "$file"
staticobj=$func_lo2o_result
func_show_eval "$install_prog \$staticobj \$staticdest" 'exit $?'
fi
exit $EXIT_SUCCESS
;;
*)
# Figure out destination file name, if it wasn't already specified.
if test -n "$destname"; then
destfile="$destdir/$destname"
else
func_basename "$file"
destfile="$func_basename_result"
destfile="$destdir/$destfile"
fi
# If the file is missing, and there is a .exe on the end, strip it
# because it is most likely a libtool script we actually want to
# install
stripped_ext=""
case $file in
*.exe)
if test ! -f "$file"; then
func_stripname '' '.exe' "$file"
file=$func_stripname_result
stripped_ext=".exe"
fi
;;
esac
# Do a test to see if this is really a libtool program.
case $host in
*cygwin* | *mingw*)
if func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
wrapper=$func_ltwrapper_scriptname_result
else
func_stripname '' '.exe' "$file"
wrapper=$func_stripname_result
fi
;;
*)
wrapper=$file
;;
esac
if func_ltwrapper_script_p "$wrapper"; then
notinst_deplibs=
relink_command=
func_source "$wrapper"
# Check the variables that should have been set.
test -z "$generated_by_libtool_version" && \
func_fatal_error "invalid libtool wrapper script \`$wrapper'"
finalize=yes
for lib in $notinst_deplibs; do
# Check to see that each library is installed.
libdir=
if test -f "$lib"; then
func_source "$lib"
fi
libfile="$libdir/"`$ECHO "$lib" | $SED 's%^.*/%%g'` ### testsuite: skip nested quoting test
if test -n "$libdir" && test ! -f "$libfile"; then
func_warning "\`$lib' has not been installed in \`$libdir'"
finalize=no
fi
done
relink_command=
func_source "$wrapper"
outputname=
if test "$fast_install" = no && test -n "$relink_command"; then
$opt_dry_run || {
if test "$finalize" = yes; then
tmpdir=`func_mktempdir`
func_basename "$file$stripped_ext"
file="$func_basename_result"
outputname="$tmpdir/$file"
# Replace the output file specification.
relink_command=`$ECHO "$relink_command" | $SED 's%@OUTPUT@%'"$outputname"'%g'`
$opt_silent || {
func_quote_for_expand "$relink_command"
eval "func_echo $func_quote_for_expand_result"
}
if eval "$relink_command"; then :
else
func_error "error: relink \`$file' with the above command before installing it"
$opt_dry_run || ${RM}r "$tmpdir"
continue
fi
file="$outputname"
else
func_warning "cannot relink \`$file'"
fi
}
else
# Install the binary that we compiled earlier.
file=`$ECHO "$file$stripped_ext" | $SED "s%\([^/]*\)$%$objdir/\1%"`
fi
fi
# remove .exe since cygwin /usr/bin/install will append another
# one anyway
case $install_prog,$host in
*/usr/bin/install*,*cygwin*)
case $file:$destfile in
*.exe:*.exe)
# this is ok
;;
*.exe:*)
destfile=$destfile.exe
;;
*:*.exe)
func_stripname '' '.exe' "$destfile"
destfile=$func_stripname_result
;;
esac
;;
esac
func_show_eval "$install_prog\$stripme \$file \$destfile" 'exit $?'
$opt_dry_run || if test -n "$outputname"; then
${RM}r "$tmpdir"
fi
;;
esac
done
for file in $staticlibs; do
func_basename "$file"
name="$func_basename_result"
# Set up the ranlib parameters.
oldlib="$destdir/$name"
func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
tool_oldlib=$func_to_tool_file_result
func_show_eval "$install_prog \$file \$oldlib" 'exit $?'
if test -n "$stripme" && test -n "$old_striplib"; then
func_show_eval "$old_striplib $tool_oldlib" 'exit $?'
fi
# Do each command in the postinstall commands.
func_execute_cmds "$old_postinstall_cmds" 'exit $?'
done
test -n "$future_libdirs" && \
func_warning "remember to run \`$progname --finish$future_libdirs'"
if test -n "$current_libdirs"; then
# Maybe just do a dry run.
$opt_dry_run && current_libdirs=" -n$current_libdirs"
exec_cmd='$SHELL $progpath $preserve_args --finish$current_libdirs'
else
exit $EXIT_SUCCESS
fi
}
test "$opt_mode" = install && func_mode_install ${1+"$@"}
# func_generate_dlsyms outputname originator pic_p
# Extract symbols from dlprefiles and create ${outputname}S.o with
# a dlpreopen symbol table.
func_generate_dlsyms ()
{
$opt_debug
my_outputname="$1"
my_originator="$2"
my_pic_p="${3-no}"
my_prefix=`$ECHO "$my_originator" | sed 's%[^a-zA-Z0-9]%_%g'`
my_dlsyms=
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
if test -n "$NM" && test -n "$global_symbol_pipe"; then
my_dlsyms="${my_outputname}S.c"
else
func_error "not configured to extract global symbols from dlpreopened files"
fi
fi
if test -n "$my_dlsyms"; then
case $my_dlsyms in
"") ;;
*.c)
# Discover the nlist of each of the dlfiles.
nlist="$output_objdir/${my_outputname}.nm"
func_show_eval "$RM $nlist ${nlist}S ${nlist}T"
# Parse the name list into a source file.
func_verbose "creating $output_objdir/$my_dlsyms"
$opt_dry_run || $ECHO > "$output_objdir/$my_dlsyms" "\
/* $my_dlsyms - symbol resolution table for \`$my_outputname' dlsym emulation. */
/* Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION */
#ifdef __cplusplus
extern \"C\" {
#endif
#if defined(__GNUC__) && (((__GNUC__ == 4) && (__GNUC_MINOR__ >= 4)) || (__GNUC__ > 4))
#pragma GCC diagnostic ignored \"-Wstrict-prototypes\"
#endif
/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */
#if defined(_WIN32) || defined(__CYGWIN__) || defined(_WIN32_WCE)
/* DATA imports from DLLs on WIN32 con't be const, because runtime
relocations are performed -- see ld's documentation on pseudo-relocs. */
# define LT_DLSYM_CONST
#elif defined(__osf__)
/* This system does not cope well with relocations in const data. */
# define LT_DLSYM_CONST
#else
# define LT_DLSYM_CONST const
#endif
/* External symbol declarations for the compiler. */\
"
if test "$dlself" = yes; then
func_verbose "generating symbol list for \`$output'"
$opt_dry_run || echo ': @PROGRAM@ ' > "$nlist"
# Add our own program objects to the symbol list.
progfiles=`$ECHO "$objs$old_deplibs" | $SP2NL | $SED "$lo2o" | $NL2SP`
for progfile in $progfiles; do
func_to_tool_file "$progfile" func_convert_file_msys_to_w32
func_verbose "extracting global C symbols from \`$func_to_tool_file_result'"
$opt_dry_run || eval "$NM $func_to_tool_file_result | $global_symbol_pipe >> '$nlist'"
done
if test -n "$exclude_expsyms"; then
$opt_dry_run || {
eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
}
fi
if test -n "$export_symbols_regex"; then
$opt_dry_run || {
eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
}
fi
# Prepare the list of exported symbols
if test -z "$export_symbols"; then
export_symbols="$output_objdir/$outputname.exp"
$opt_dry_run || {
$RM $export_symbols
eval "${SED} -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
case $host in
*cygwin* | *mingw* | *cegcc* )
eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"'
;;
esac
}
else
$opt_dry_run || {
eval "${SED} -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"'
eval '$GREP -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T'
eval '$MV "$nlist"T "$nlist"'
case $host in
*cygwin* | *mingw* | *cegcc* )
eval "echo EXPORTS "'> "$output_objdir/$outputname.def"'
eval 'cat "$nlist" >> "$output_objdir/$outputname.def"'
;;
esac
}
fi
fi
for dlprefile in $dlprefiles; do
func_verbose "extracting global C symbols from \`$dlprefile'"
func_basename "$dlprefile"
name="$func_basename_result"
case $host in
*cygwin* | *mingw* | *cegcc* )
# if an import library, we need to obtain dlname
if func_win32_import_lib_p "$dlprefile"; then
func_tr_sh "$dlprefile"
eval "curr_lafile=\$libfile_$func_tr_sh_result"
dlprefile_dlbasename=""
if test -n "$curr_lafile" && func_lalib_p "$curr_lafile"; then
# Use subshell, to avoid clobbering current variable values
dlprefile_dlname=`source "$curr_lafile" && echo "$dlname"`
if test -n "$dlprefile_dlname" ; then
func_basename "$dlprefile_dlname"
dlprefile_dlbasename="$func_basename_result"
else
# no lafile. user explicitly requested -dlpreopen .
$sharedlib_from_linklib_cmd "$dlprefile"
dlprefile_dlbasename=$sharedlib_from_linklib_result
fi
fi
$opt_dry_run || {
if test -n "$dlprefile_dlbasename" ; then
eval '$ECHO ": $dlprefile_dlbasename" >> "$nlist"'
else
func_warning "Could not compute DLL name from $name"
eval '$ECHO ": $name " >> "$nlist"'
fi
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe |
$SED -e '/I __imp/d' -e 's/I __nm_/D /;s/_nm__//' >> '$nlist'"
}
else # not an import lib
$opt_dry_run || {
eval '$ECHO ": $name " >> "$nlist"'
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
}
fi
;;
*)
$opt_dry_run || {
eval '$ECHO ": $name " >> "$nlist"'
func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32
eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'"
}
;;
esac
done
$opt_dry_run || {
# Make sure we have at least an empty file.
test -f "$nlist" || : > "$nlist"
if test -n "$exclude_expsyms"; then
$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
$MV "$nlist"T "$nlist"
fi
# Try sorting and uniquifying the output.
if $GREP -v "^: " < "$nlist" |
if sort -k 3 /dev/null 2>&1; then
sort -k 3
else
sort +2
fi |
uniq > "$nlist"S; then
:
else
$GREP -v "^: " < "$nlist" > "$nlist"S
fi
if test -f "$nlist"S; then
eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$my_dlsyms"'
else
echo '/* NONE */' >> "$output_objdir/$my_dlsyms"
fi
echo >> "$output_objdir/$my_dlsyms" "\
/* The mapping between symbol names and symbols. */
typedef struct {
const char *name;
void *address;
} lt_dlsymlist;
extern LT_DLSYM_CONST lt_dlsymlist
lt_${my_prefix}_LTX_preloaded_symbols[];
LT_DLSYM_CONST lt_dlsymlist
lt_${my_prefix}_LTX_preloaded_symbols[] =
{\
{ \"$my_originator\", (void *) 0 },"
case $need_lib_prefix in
no)
eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$my_dlsyms"
;;
*)
eval "$global_symbol_to_c_name_address_lib_prefix" < "$nlist" >> "$output_objdir/$my_dlsyms"
;;
esac
echo >> "$output_objdir/$my_dlsyms" "\
{0, (void *) 0}
};
/* This works around a problem in FreeBSD linker */
#ifdef FREEBSD_WORKAROUND
static const void *lt_preloaded_setup() {
return lt_${my_prefix}_LTX_preloaded_symbols;
}
#endif
#ifdef __cplusplus
}
#endif\
"
} # !$opt_dry_run
pic_flag_for_symtable=
case "$compile_command " in
*" -static "*) ;;
*)
case $host in
# compiling the symbol table file with pic_flag works around
# a FreeBSD bug that causes programs to crash when -lm is
# linked before any other PIC object. But we must not use
# pic_flag when linking with -static. The problem exists in
# FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
*-*-freebsd2.*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND" ;;
*-*-hpux*)
pic_flag_for_symtable=" $pic_flag" ;;
*)
if test "X$my_pic_p" != Xno; then
pic_flag_for_symtable=" $pic_flag"
fi
;;
esac
;;
esac
symtab_cflags=
for arg in $LTCFLAGS; do
case $arg in
-pie | -fpie | -fPIE) ;;
*) func_append symtab_cflags " $arg" ;;
esac
done
# Now compile the dynamic symbol file.
func_show_eval '(cd $output_objdir && $LTCC$symtab_cflags -c$no_builtin_flag$pic_flag_for_symtable "$my_dlsyms")' 'exit $?'
# Clean up the generated files.
func_show_eval '$RM "$output_objdir/$my_dlsyms" "$nlist" "${nlist}S" "${nlist}T"'
# Transform the symbol file into the correct name.
symfileobj="$output_objdir/${my_outputname}S.$objext"
case $host in
*cygwin* | *mingw* | *cegcc* )
if test -f "$output_objdir/$my_outputname.def"; then
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"`
else
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
fi
;;
*)
compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"`
;;
esac
;;
*)
func_fatal_error "unknown suffix for \`$my_dlsyms'"
;;
esac
else
# We keep going just in case the user didn't refer to
# lt_preloaded_symbols. The linker will fail if global_symbol_pipe
# really was required.
# Nullify the symbol file.
compile_command=`$ECHO "$compile_command" | $SED "s% @SYMFILE@%%"`
finalize_command=`$ECHO "$finalize_command" | $SED "s% @SYMFILE@%%"`
fi
}
# func_win32_libid arg
# return the library type of file 'arg'
#
# Need a lot of goo to handle *both* DLLs and import libs
# Has to be a shell function in order to 'eat' the argument
# that is supplied when $file_magic_command is called.
# Despite the name, also deal with 64 bit binaries.
func_win32_libid ()
{
$opt_debug
win32_libid_type="unknown"
win32_fileres=`file -L $1 2>/dev/null`
case $win32_fileres in
*ar\ archive\ import\ library*) # definitely import
win32_libid_type="x86 archive import"
;;
*ar\ archive*) # could be an import, or static
# Keep the egrep pattern in sync with the one in _LT_CHECK_MAGIC_METHOD.
if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null |
$EGREP 'file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' >/dev/null; then
func_to_tool_file "$1" func_convert_file_msys_to_w32
win32_nmres=`eval $NM -f posix -A \"$func_to_tool_file_result\" |
$SED -n -e '
1,100{
/ I /{
s,.*,import,
p
q
}
}'`
case $win32_nmres in
import*) win32_libid_type="x86 archive import";;
*) win32_libid_type="x86 archive static";;
esac
fi
;;
*DLL*)
win32_libid_type="x86 DLL"
;;
*executable*) # but shell scripts are "executable" too...
case $win32_fileres in
*MS\ Windows\ PE\ Intel*)
win32_libid_type="x86 DLL"
;;
esac
;;
esac
$ECHO "$win32_libid_type"
}
# func_cygming_dll_for_implib ARG
#
# Platform-specific function to extract the
# name of the DLL associated with the specified
# import library ARG.
# Invoked by eval'ing the libtool variable
# $sharedlib_from_linklib_cmd
# Result is available in the variable
# $sharedlib_from_linklib_result
func_cygming_dll_for_implib ()
{
$opt_debug
sharedlib_from_linklib_result=`$DLLTOOL --identify-strict --identify "$1"`
}
# func_cygming_dll_for_implib_fallback_core SECTION_NAME LIBNAMEs
#
# The is the core of a fallback implementation of a
# platform-specific function to extract the name of the
# DLL associated with the specified import library LIBNAME.
#
# SECTION_NAME is either .idata$6 or .idata$7, depending
# on the platform and compiler that created the implib.
#
# Echos the name of the DLL associated with the
# specified import library.
func_cygming_dll_for_implib_fallback_core ()
{
$opt_debug
match_literal=`$ECHO "$1" | $SED "$sed_make_literal_regex"`
$OBJDUMP -s --section "$1" "$2" 2>/dev/null |
$SED '/^Contents of section '"$match_literal"':/{
# Place marker at beginning of archive member dllname section
s/.*/====MARK====/
p
d
}
# These lines can sometimes be longer than 43 characters, but
# are always uninteresting
/:[ ]*file format pe[i]\{,1\}-/d
/^In archive [^:]*:/d
# Ensure marker is printed
/^====MARK====/p
# Remove all lines with less than 43 characters
/^.\{43\}/!d
# From remaining lines, remove first 43 characters
s/^.\{43\}//' |
$SED -n '
# Join marker and all lines until next marker into a single line
/^====MARK====/ b para
H
$ b para
b
:para
x
s/\n//g
# Remove the marker
s/^====MARK====//
# Remove trailing dots and whitespace
s/[\. \t]*$//
# Print
/./p' |
# we now have a list, one entry per line, of the stringified
# contents of the appropriate section of all members of the
# archive which possess that section. Heuristic: eliminate
# all those which have a first or second character that is
# a '.' (that is, objdump's representation of an unprintable
# character.) This should work for all archives with less than
# 0x302f exports -- but will fail for DLLs whose name actually
# begins with a literal '.' or a single character followed by
# a '.'.
#
# Of those that remain, print the first one.
$SED -e '/^\./d;/^.\./d;q'
}
# func_cygming_gnu_implib_p ARG
# This predicate returns with zero status (TRUE) if
# ARG is a GNU/binutils-style import library. Returns
# with nonzero status (FALSE) otherwise.
func_cygming_gnu_implib_p ()
{
$opt_debug
func_to_tool_file "$1" func_convert_file_msys_to_w32
func_cygming_gnu_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $EGREP ' (_head_[A-Za-z0-9_]+_[ad]l*|[A-Za-z0-9_]+_[ad]l*_iname)$'`
test -n "$func_cygming_gnu_implib_tmp"
}
# func_cygming_ms_implib_p ARG
# This predicate returns with zero status (TRUE) if
# ARG is an MS-style import library. Returns
# with nonzero status (FALSE) otherwise.
func_cygming_ms_implib_p ()
{
$opt_debug
func_to_tool_file "$1" func_convert_file_msys_to_w32
func_cygming_ms_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $GREP '_NULL_IMPORT_DESCRIPTOR'`
test -n "$func_cygming_ms_implib_tmp"
}
# func_cygming_dll_for_implib_fallback ARG
# Platform-specific function to extract the
# name of the DLL associated with the specified
# import library ARG.
#
# This fallback implementation is for use when $DLLTOOL
# does not support the --identify-strict option.
# Invoked by eval'ing the libtool variable
# $sharedlib_from_linklib_cmd
# Result is available in the variable
# $sharedlib_from_linklib_result
func_cygming_dll_for_implib_fallback ()
{
$opt_debug
if func_cygming_gnu_implib_p "$1" ; then
# binutils import library
sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$7' "$1"`
elif func_cygming_ms_implib_p "$1" ; then
# ms-generated import library
sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$6' "$1"`
else
# unknown
sharedlib_from_linklib_result=""
fi
}
# func_extract_an_archive dir oldlib
func_extract_an_archive ()
{
$opt_debug
f_ex_an_ar_dir="$1"; shift
f_ex_an_ar_oldlib="$1"
if test "$lock_old_archive_extraction" = yes; then
lockfile=$f_ex_an_ar_oldlib.lock
until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do
func_echo "Waiting for $lockfile to be removed"
sleep 2
done
fi
func_show_eval "(cd \$f_ex_an_ar_dir && $AR x \"\$f_ex_an_ar_oldlib\")" \
'stat=$?; rm -f "$lockfile"; exit $stat'
if test "$lock_old_archive_extraction" = yes; then
$opt_dry_run || rm -f "$lockfile"
fi
if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then
:
else
func_fatal_error "object name conflicts in archive: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib"
fi
}
# func_extract_archives gentop oldlib ...
func_extract_archives ()
{
$opt_debug
my_gentop="$1"; shift
my_oldlibs=${1+"$@"}
my_oldobjs=""
my_xlib=""
my_xabs=""
my_xdir=""
for my_xlib in $my_oldlibs; do
# Extract the objects.
case $my_xlib in
[\\/]* | [A-Za-z]:[\\/]*) my_xabs="$my_xlib" ;;
*) my_xabs=`pwd`"/$my_xlib" ;;
esac
func_basename "$my_xlib"
my_xlib="$func_basename_result"
my_xlib_u=$my_xlib
while :; do
case " $extracted_archives " in
*" $my_xlib_u "*)
func_arith $extracted_serial + 1
extracted_serial=$func_arith_result
my_xlib_u=lt$extracted_serial-$my_xlib ;;
*) break ;;
esac
done
extracted_archives="$extracted_archives $my_xlib_u"
my_xdir="$my_gentop/$my_xlib_u"
func_mkdir_p "$my_xdir"
case $host in
*-darwin*)
func_verbose "Extracting $my_xabs"
# Do not bother doing anything if just a dry run
$opt_dry_run || {
darwin_orig_dir=`pwd`
cd $my_xdir || exit $?
darwin_archive=$my_xabs
darwin_curdir=`pwd`
darwin_base_archive=`basename "$darwin_archive"`
darwin_arches=`$LIPO -info "$darwin_archive" 2>/dev/null | $GREP Architectures 2>/dev/null || true`
if test -n "$darwin_arches"; then
darwin_arches=`$ECHO "$darwin_arches" | $SED -e 's/.*are://'`
darwin_arch=
func_verbose "$darwin_base_archive has multiple architectures $darwin_arches"
for darwin_arch in $darwin_arches ; do
func_mkdir_p "unfat-$$/${darwin_base_archive}-${darwin_arch}"
$LIPO -thin $darwin_arch -output "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}" "${darwin_archive}"
cd "unfat-$$/${darwin_base_archive}-${darwin_arch}"
func_extract_an_archive "`pwd`" "${darwin_base_archive}"
cd "$darwin_curdir"
$RM "unfat-$$/${darwin_base_archive}-${darwin_arch}/${darwin_base_archive}"
done # $darwin_arches
## Okay now we've a bunch of thin objects, gotta fatten them up :)
darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print | $SED -e "$basename" | sort -u`
darwin_file=
darwin_files=
for darwin_file in $darwin_filelist; do
darwin_files=`find unfat-$$ -name $darwin_file -print | sort | $NL2SP`
$LIPO -create -output "$darwin_file" $darwin_files
done # $darwin_filelist
$RM -rf unfat-$$
cd "$darwin_orig_dir"
else
cd $darwin_orig_dir
func_extract_an_archive "$my_xdir" "$my_xabs"
fi # $darwin_arches
} # !$opt_dry_run
;;
*)
func_extract_an_archive "$my_xdir" "$my_xabs"
;;
esac
my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | sort | $NL2SP`
done
func_extract_archives_result="$my_oldobjs"
}
# func_emit_wrapper [arg=no]
#
# Emit a libtool wrapper script on stdout.
# Don't directly open a file because we may want to
# incorporate the script contents within a cygwin/mingw
# wrapper executable. Must ONLY be called from within
# func_mode_link because it depends on a number of variables
# set therein.
#
# ARG is the value that the WRAPPER_SCRIPT_BELONGS_IN_OBJDIR
# variable will take. If 'yes', then the emitted script
# will assume that the directory in which it is stored is
# the $objdir directory. This is a cygwin/mingw-specific
# behavior.
func_emit_wrapper ()
{
func_emit_wrapper_arg1=${1-no}
$ECHO "\
#! $SHELL
# $output - temporary wrapper script for $objdir/$outputname
# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
#
# The $output program cannot be directly executed until all the libtool
# libraries that it depends on are installed.
#
# This wrapper script should never be moved out of the build directory.
# If it is, it will not operate correctly.
# Sed substitution that helps us do robust quoting. It backslashifies
# metacharacters that are still active within double-quoted strings.
sed_quote_subst='$sed_quote_subst'
# Be Bourne compatible
if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then
emulate sh
NULLCMD=:
# Zsh 3.x and 4.x performs word splitting on \${1+\"\$@\"}, which
# is contrary to our usage. Disable this feature.
alias -g '\${1+\"\$@\"}'='\"\$@\"'
setopt NO_GLOB_SUBST
else
case \`(set -o) 2>/dev/null\` in *posix*) set -o posix;; esac
fi
BIN_SH=xpg4; export BIN_SH # for Tru64
DUALCASE=1; export DUALCASE # for MKS sh
# The HP-UX ksh and POSIX shell print the target directory to stdout
# if CDPATH is set.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
relink_command=\"$relink_command\"
# This environment variable determines our operation mode.
if test \"\$libtool_install_magic\" = \"$magic\"; then
# install mode needs the following variables:
generated_by_libtool_version='$macro_version'
notinst_deplibs='$notinst_deplibs'
else
# When we are sourced in execute mode, \$file and \$ECHO are already set.
if test \"\$libtool_execute_magic\" != \"$magic\"; then
file=\"\$0\""
qECHO=`$ECHO "$ECHO" | $SED "$sed_quote_subst"`
$ECHO "\
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
\$1
_LTECHO_EOF'
}
ECHO=\"$qECHO\"
fi
# Very basic option parsing. These options are (a) specific to
# the libtool wrapper, (b) are identical between the wrapper
# /script/ and the wrapper /executable/ which is used only on
# windows platforms, and (c) all begin with the string "--lt-"
# (application programs are unlikely to have options which match
# this pattern).
#
# There are only two supported options: --lt-debug and
# --lt-dump-script. There is, deliberately, no --lt-help.
#
# The first argument to this parsing function should be the
# script's $0 value, followed by "$@".
lt_option_debug=
func_parse_lt_options ()
{
lt_script_arg0=\$0
shift
for lt_opt
do
case \"\$lt_opt\" in
--lt-debug) lt_option_debug=1 ;;
--lt-dump-script)
lt_dump_D=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%/[^/]*$%%'\`
test \"X\$lt_dump_D\" = \"X\$lt_script_arg0\" && lt_dump_D=.
lt_dump_F=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%^.*/%%'\`
cat \"\$lt_dump_D/\$lt_dump_F\"
exit 0
;;
--lt-*)
\$ECHO \"Unrecognized --lt- option: '\$lt_opt'\" 1>&2
exit 1
;;
esac
done
# Print the debug banner immediately:
if test -n \"\$lt_option_debug\"; then
echo \"${outputname}:${output}:\${LINENO}: libtool wrapper (GNU $PACKAGE$TIMESTAMP) $VERSION\" 1>&2
fi
}
# Used when --lt-debug. Prints its arguments to stdout
# (redirection is the responsibility of the caller)
func_lt_dump_args ()
{
lt_dump_args_N=1;
for lt_arg
do
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[\$lt_dump_args_N]: \$lt_arg\"
lt_dump_args_N=\`expr \$lt_dump_args_N + 1\`
done
}
# Core function for launching the target application
func_exec_program_core ()
{
"
case $host in
# Backslashes separate directories on plain windows
*-*-mingw | *-*-os2* | *-cegcc*)
$ECHO "\
if test -n \"\$lt_option_debug\"; then
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[0]: \$progdir\\\\\$program\" 1>&2
func_lt_dump_args \${1+\"\$@\"} 1>&2
fi
exec \"\$progdir\\\\\$program\" \${1+\"\$@\"}
"
;;
*)
$ECHO "\
if test -n \"\$lt_option_debug\"; then
\$ECHO \"${outputname}:${output}:\${LINENO}: newargv[0]: \$progdir/\$program\" 1>&2
func_lt_dump_args \${1+\"\$@\"} 1>&2
fi
exec \"\$progdir/\$program\" \${1+\"\$@\"}
"
;;
esac
$ECHO "\
\$ECHO \"\$0: cannot exec \$program \$*\" 1>&2
exit 1
}
# A function to encapsulate launching the target application
# Strips options in the --lt-* namespace from \$@ and
# launches target application with the remaining arguments.
func_exec_program ()
{
case \" \$* \" in
*\\ --lt-*)
for lt_wr_arg
do
case \$lt_wr_arg in
--lt-*) ;;
*) set x \"\$@\" \"\$lt_wr_arg\"; shift;;
esac
shift
done ;;
esac
func_exec_program_core \${1+\"\$@\"}
}
# Parse options
func_parse_lt_options \"\$0\" \${1+\"\$@\"}
# Find the directory that this script lives in.
thisdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*$%%'\`
test \"x\$thisdir\" = \"x\$file\" && thisdir=.
# Follow symbolic links until we get to the real thisdir.
file=\`ls -ld \"\$file\" | $SED -n 's/.*-> //p'\`
while test -n \"\$file\"; do
destdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*\$%%'\`
# If there was a directory component, then change thisdir.
if test \"x\$destdir\" != \"x\$file\"; then
case \"\$destdir\" in
[\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;;
*) thisdir=\"\$thisdir/\$destdir\" ;;
esac
fi
file=\`\$ECHO \"\$file\" | $SED 's%^.*/%%'\`
file=\`ls -ld \"\$thisdir/\$file\" | $SED -n 's/.*-> //p'\`
done
# Usually 'no', except on cygwin/mingw when embedded into
# the cwrapper.
WRAPPER_SCRIPT_BELONGS_IN_OBJDIR=$func_emit_wrapper_arg1
if test \"\$WRAPPER_SCRIPT_BELONGS_IN_OBJDIR\" = \"yes\"; then
# special case for '.'
if test \"\$thisdir\" = \".\"; then
thisdir=\`pwd\`
fi
# remove .libs from thisdir
case \"\$thisdir\" in
*[\\\\/]$objdir ) thisdir=\`\$ECHO \"\$thisdir\" | $SED 's%[\\\\/][^\\\\/]*$%%'\` ;;
$objdir ) thisdir=. ;;
esac
fi
# Try to get the absolute directory name.
absdir=\`cd \"\$thisdir\" && pwd\`
test -n \"\$absdir\" && thisdir=\"\$absdir\"
"
if test "$fast_install" = yes; then
$ECHO "\
program=lt-'$outputname'$exeext
progdir=\"\$thisdir/$objdir\"
if test ! -f \"\$progdir/\$program\" ||
{ file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | ${SED} 1q\`; \\
test \"X\$file\" != \"X\$progdir/\$program\"; }; then
file=\"\$\$-\$program\"
if test ! -d \"\$progdir\"; then
$MKDIR \"\$progdir\"
else
$RM \"\$progdir/\$file\"
fi"
$ECHO "\
# relink executable if necessary
if test -n \"\$relink_command\"; then
if relink_command_output=\`eval \$relink_command 2>&1\`; then :
else
$ECHO \"\$relink_command_output\" >&2
$RM \"\$progdir/\$file\"
exit 1
fi
fi
$MV \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
{ $RM \"\$progdir/\$program\";
$MV \"\$progdir/\$file\" \"\$progdir/\$program\"; }
$RM \"\$progdir/\$file\"
fi"
else
$ECHO "\
program='$outputname'
progdir=\"\$thisdir/$objdir\"
"
fi
$ECHO "\
if test -f \"\$progdir/\$program\"; then"
# fixup the dll searchpath if we need to.
#
# Fix the DLL searchpath if we need to. Do this before prepending
# to shlibpath, because on Windows, both are PATH and uninstalled
# libraries must come first.
if test -n "$dllsearchpath"; then
$ECHO "\
# Add the dll search path components to the executable PATH
PATH=$dllsearchpath:\$PATH
"
fi
# Export our shlibpath_var if we have one.
if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
$ECHO "\
# Add our own library path to $shlibpath_var
$shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
# Some systems cannot cope with colon-terminated $shlibpath_var
# The second colon is a workaround for a bug in BeOS R4 sed
$shlibpath_var=\`\$ECHO \"\$$shlibpath_var\" | $SED 's/::*\$//'\`
export $shlibpath_var
"
fi
$ECHO "\
if test \"\$libtool_execute_magic\" != \"$magic\"; then
# Run the actual program with our arguments.
func_exec_program \${1+\"\$@\"}
fi
else
# The program doesn't exist.
\$ECHO \"\$0: error: \\\`\$progdir/\$program' does not exist\" 1>&2
\$ECHO \"This script is just a wrapper for \$program.\" 1>&2
\$ECHO \"See the $PACKAGE documentation for more information.\" 1>&2
exit 1
fi
fi\
"
}
# func_emit_cwrapperexe_src
# emit the source code for a wrapper executable on stdout
# Must ONLY be called from within func_mode_link because
# it depends on a number of variable set therein.
func_emit_cwrapperexe_src ()
{
cat <
#include
#ifdef _MSC_VER
# include
# include
# include
#else
# include
# include
# ifdef __CYGWIN__
# include
# endif
#endif
#include
#include
#include
#include
#include
#include
#include
#include
/* declarations of non-ANSI functions */
#if defined(__MINGW32__)
# ifdef __STRICT_ANSI__
int _putenv (const char *);
# endif
#elif defined(__CYGWIN__)
# ifdef __STRICT_ANSI__
char *realpath (const char *, char *);
int putenv (char *);
int setenv (const char *, const char *, int);
# endif
/* #elif defined (other platforms) ... */
#endif
/* portability defines, excluding path handling macros */
#if defined(_MSC_VER)
# define setmode _setmode
# define stat _stat
# define chmod _chmod
# define getcwd _getcwd
# define putenv _putenv
# define S_IXUSR _S_IEXEC
# ifndef _INTPTR_T_DEFINED
# define _INTPTR_T_DEFINED
# define intptr_t int
# endif
#elif defined(__MINGW32__)
# define setmode _setmode
# define stat _stat
# define chmod _chmod
# define getcwd _getcwd
# define putenv _putenv
#elif defined(__CYGWIN__)
# define HAVE_SETENV
# define FOPEN_WB "wb"
/* #elif defined (other platforms) ... */
#endif
#if defined(PATH_MAX)
# define LT_PATHMAX PATH_MAX
#elif defined(MAXPATHLEN)
# define LT_PATHMAX MAXPATHLEN
#else
# define LT_PATHMAX 1024
#endif
#ifndef S_IXOTH
# define S_IXOTH 0
#endif
#ifndef S_IXGRP
# define S_IXGRP 0
#endif
/* path handling portability macros */
#ifndef DIR_SEPARATOR
# define DIR_SEPARATOR '/'
# define PATH_SEPARATOR ':'
#endif
#if defined (_WIN32) || defined (__MSDOS__) || defined (__DJGPP__) || \
defined (__OS2__)
# define HAVE_DOS_BASED_FILE_SYSTEM
# define FOPEN_WB "wb"
# ifndef DIR_SEPARATOR_2
# define DIR_SEPARATOR_2 '\\'
# endif
# ifndef PATH_SEPARATOR_2
# define PATH_SEPARATOR_2 ';'
# endif
#endif
#ifndef DIR_SEPARATOR_2
# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR)
#else /* DIR_SEPARATOR_2 */
# define IS_DIR_SEPARATOR(ch) \
(((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2))
#endif /* DIR_SEPARATOR_2 */
#ifndef PATH_SEPARATOR_2
# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR)
#else /* PATH_SEPARATOR_2 */
# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2)
#endif /* PATH_SEPARATOR_2 */
#ifndef FOPEN_WB
# define FOPEN_WB "w"
#endif
#ifndef _O_BINARY
# define _O_BINARY 0
#endif
#define XMALLOC(type, num) ((type *) xmalloc ((num) * sizeof(type)))
#define XFREE(stale) do { \
if (stale) { free ((void *) stale); stale = 0; } \
} while (0)
#if defined(LT_DEBUGWRAPPER)
static int lt_debug = 1;
#else
static int lt_debug = 0;
#endif
const char *program_name = "libtool-wrapper"; /* in case xstrdup fails */
void *xmalloc (size_t num);
char *xstrdup (const char *string);
const char *base_name (const char *name);
char *find_executable (const char *wrapper);
char *chase_symlinks (const char *pathspec);
int make_executable (const char *path);
int check_executable (const char *path);
char *strendzap (char *str, const char *pat);
void lt_debugprintf (const char *file, int line, const char *fmt, ...);
void lt_fatal (const char *file, int line, const char *message, ...);
static const char *nonnull (const char *s);
static const char *nonempty (const char *s);
void lt_setenv (const char *name, const char *value);
char *lt_extend_str (const char *orig_value, const char *add, int to_end);
void lt_update_exe_path (const char *name, const char *value);
void lt_update_lib_path (const char *name, const char *value);
char **prepare_spawn (char **argv);
void lt_dump_script (FILE *f);
EOF
cat <= 0)
&& (st.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH)))
return 1;
else
return 0;
}
int
make_executable (const char *path)
{
int rval = 0;
struct stat st;
lt_debugprintf (__FILE__, __LINE__, "(make_executable): %s\n",
nonempty (path));
if ((!path) || (!*path))
return 0;
if (stat (path, &st) >= 0)
{
rval = chmod (path, st.st_mode | S_IXOTH | S_IXGRP | S_IXUSR);
}
return rval;
}
/* Searches for the full path of the wrapper. Returns
newly allocated full path name if found, NULL otherwise
Does not chase symlinks, even on platforms that support them.
*/
char *
find_executable (const char *wrapper)
{
int has_slash = 0;
const char *p;
const char *p_next;
/* static buffer for getcwd */
char tmp[LT_PATHMAX + 1];
int tmp_len;
char *concat_name;
lt_debugprintf (__FILE__, __LINE__, "(find_executable): %s\n",
nonempty (wrapper));
if ((wrapper == NULL) || (*wrapper == '\0'))
return NULL;
/* Absolute path? */
#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
if (isalpha ((unsigned char) wrapper[0]) && wrapper[1] == ':')
{
concat_name = xstrdup (wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
else
{
#endif
if (IS_DIR_SEPARATOR (wrapper[0]))
{
concat_name = xstrdup (wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
#if defined (HAVE_DOS_BASED_FILE_SYSTEM)
}
#endif
for (p = wrapper; *p; p++)
if (*p == '/')
{
has_slash = 1;
break;
}
if (!has_slash)
{
/* no slashes; search PATH */
const char *path = getenv ("PATH");
if (path != NULL)
{
for (p = path; *p; p = p_next)
{
const char *q;
size_t p_len;
for (q = p; *q; q++)
if (IS_PATH_SEPARATOR (*q))
break;
p_len = q - p;
p_next = (*q == '\0' ? q : q + 1);
if (p_len == 0)
{
/* empty path: current directory */
if (getcwd (tmp, LT_PATHMAX) == NULL)
lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
nonnull (strerror (errno)));
tmp_len = strlen (tmp);
concat_name =
XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, tmp, tmp_len);
concat_name[tmp_len] = '/';
strcpy (concat_name + tmp_len + 1, wrapper);
}
else
{
concat_name =
XMALLOC (char, p_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, p, p_len);
concat_name[p_len] = '/';
strcpy (concat_name + p_len + 1, wrapper);
}
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
}
}
/* not found in PATH; assume curdir */
}
/* Relative path | not found in path: prepend cwd */
if (getcwd (tmp, LT_PATHMAX) == NULL)
lt_fatal (__FILE__, __LINE__, "getcwd failed: %s",
nonnull (strerror (errno)));
tmp_len = strlen (tmp);
concat_name = XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1);
memcpy (concat_name, tmp, tmp_len);
concat_name[tmp_len] = '/';
strcpy (concat_name + tmp_len + 1, wrapper);
if (check_executable (concat_name))
return concat_name;
XFREE (concat_name);
return NULL;
}
char *
chase_symlinks (const char *pathspec)
{
#ifndef S_ISLNK
return xstrdup (pathspec);
#else
char buf[LT_PATHMAX];
struct stat s;
char *tmp_pathspec = xstrdup (pathspec);
char *p;
int has_symlinks = 0;
while (strlen (tmp_pathspec) && !has_symlinks)
{
lt_debugprintf (__FILE__, __LINE__,
"checking path component for symlinks: %s\n",
tmp_pathspec);
if (lstat (tmp_pathspec, &s) == 0)
{
if (S_ISLNK (s.st_mode) != 0)
{
has_symlinks = 1;
break;
}
/* search backwards for last DIR_SEPARATOR */
p = tmp_pathspec + strlen (tmp_pathspec) - 1;
while ((p > tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
p--;
if ((p == tmp_pathspec) && (!IS_DIR_SEPARATOR (*p)))
{
/* no more DIR_SEPARATORS left */
break;
}
*p = '\0';
}
else
{
lt_fatal (__FILE__, __LINE__,
"error accessing file \"%s\": %s",
tmp_pathspec, nonnull (strerror (errno)));
}
}
XFREE (tmp_pathspec);
if (!has_symlinks)
{
return xstrdup (pathspec);
}
tmp_pathspec = realpath (pathspec, buf);
if (tmp_pathspec == 0)
{
lt_fatal (__FILE__, __LINE__,
"could not follow symlinks for %s", pathspec);
}
return xstrdup (tmp_pathspec);
#endif
}
char *
strendzap (char *str, const char *pat)
{
size_t len, patlen;
assert (str != NULL);
assert (pat != NULL);
len = strlen (str);
patlen = strlen (pat);
if (patlen <= len)
{
str += len - patlen;
if (strcmp (str, pat) == 0)
*str = '\0';
}
return str;
}
void
lt_debugprintf (const char *file, int line, const char *fmt, ...)
{
va_list args;
if (lt_debug)
{
(void) fprintf (stderr, "%s:%s:%d: ", program_name, file, line);
va_start (args, fmt);
(void) vfprintf (stderr, fmt, args);
va_end (args);
}
}
static void
lt_error_core (int exit_status, const char *file,
int line, const char *mode,
const char *message, va_list ap)
{
fprintf (stderr, "%s:%s:%d: %s: ", program_name, file, line, mode);
vfprintf (stderr, message, ap);
fprintf (stderr, ".\n");
if (exit_status >= 0)
exit (exit_status);
}
void
lt_fatal (const char *file, int line, const char *message, ...)
{
va_list ap;
va_start (ap, message);
lt_error_core (EXIT_FAILURE, file, line, "FATAL", message, ap);
va_end (ap);
}
static const char *
nonnull (const char *s)
{
return s ? s : "(null)";
}
static const char *
nonempty (const char *s)
{
return (s && !*s) ? "(empty)" : nonnull (s);
}
void
lt_setenv (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_setenv) setting '%s' to '%s'\n",
nonnull (name), nonnull (value));
{
#ifdef HAVE_SETENV
/* always make a copy, for consistency with !HAVE_SETENV */
char *str = xstrdup (value);
setenv (name, str, 1);
#else
int len = strlen (name) + 1 + strlen (value) + 1;
char *str = XMALLOC (char, len);
sprintf (str, "%s=%s", name, value);
if (putenv (str) != EXIT_SUCCESS)
{
XFREE (str);
}
#endif
}
}
char *
lt_extend_str (const char *orig_value, const char *add, int to_end)
{
char *new_value;
if (orig_value && *orig_value)
{
int orig_value_len = strlen (orig_value);
int add_len = strlen (add);
new_value = XMALLOC (char, add_len + orig_value_len + 1);
if (to_end)
{
strcpy (new_value, orig_value);
strcpy (new_value + orig_value_len, add);
}
else
{
strcpy (new_value, add);
strcpy (new_value + add_len, orig_value);
}
}
else
{
new_value = xstrdup (add);
}
return new_value;
}
void
lt_update_exe_path (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_update_exe_path) modifying '%s' by prepending '%s'\n",
nonnull (name), nonnull (value));
if (name && *name && value && *value)
{
char *new_value = lt_extend_str (getenv (name), value, 0);
/* some systems can't cope with a ':'-terminated path #' */
int len = strlen (new_value);
while (((len = strlen (new_value)) > 0) && IS_PATH_SEPARATOR (new_value[len-1]))
{
new_value[len-1] = '\0';
}
lt_setenv (name, new_value);
XFREE (new_value);
}
}
void
lt_update_lib_path (const char *name, const char *value)
{
lt_debugprintf (__FILE__, __LINE__,
"(lt_update_lib_path) modifying '%s' by prepending '%s'\n",
nonnull (name), nonnull (value));
if (name && *name && value && *value)
{
char *new_value = lt_extend_str (getenv (name), value, 0);
lt_setenv (name, new_value);
XFREE (new_value);
}
}
EOF
case $host_os in
mingw*)
cat <<"EOF"
/* Prepares an argument vector before calling spawn().
Note that spawn() does not by itself call the command interpreter
(getenv ("COMSPEC") != NULL ? getenv ("COMSPEC") :
({ OSVERSIONINFO v; v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
GetVersionEx(&v);
v.dwPlatformId == VER_PLATFORM_WIN32_NT;
}) ? "cmd.exe" : "command.com").
Instead it simply concatenates the arguments, separated by ' ', and calls
CreateProcess(). We must quote the arguments since Win32 CreateProcess()
interprets characters like ' ', '\t', '\\', '"' (but not '<' and '>') in a
special way:
- Space and tab are interpreted as delimiters. They are not treated as
delimiters if they are surrounded by double quotes: "...".
- Unescaped double quotes are removed from the input. Their only effect is
that within double quotes, space and tab are treated like normal
characters.
- Backslashes not followed by double quotes are not special.
- But 2*n+1 backslashes followed by a double quote become
n backslashes followed by a double quote (n >= 0):
\" -> "
\\\" -> \"
\\\\\" -> \\"
*/
#define SHELL_SPECIAL_CHARS "\"\\ \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
#define SHELL_SPACE_CHARS " \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037"
char **
prepare_spawn (char **argv)
{
size_t argc;
char **new_argv;
size_t i;
/* Count number of arguments. */
for (argc = 0; argv[argc] != NULL; argc++)
;
/* Allocate new argument vector. */
new_argv = XMALLOC (char *, argc + 1);
/* Put quoted arguments into the new argument vector. */
for (i = 0; i < argc; i++)
{
const char *string = argv[i];
if (string[0] == '\0')
new_argv[i] = xstrdup ("\"\"");
else if (strpbrk (string, SHELL_SPECIAL_CHARS) != NULL)
{
int quote_around = (strpbrk (string, SHELL_SPACE_CHARS) != NULL);
size_t length;
unsigned int backslashes;
const char *s;
char *quoted_string;
char *p;
length = 0;
backslashes = 0;
if (quote_around)
length++;
for (s = string; *s != '\0'; s++)
{
char c = *s;
if (c == '"')
length += backslashes + 1;
length++;
if (c == '\\')
backslashes++;
else
backslashes = 0;
}
if (quote_around)
length += backslashes + 1;
quoted_string = XMALLOC (char, length + 1);
p = quoted_string;
backslashes = 0;
if (quote_around)
*p++ = '"';
for (s = string; *s != '\0'; s++)
{
char c = *s;
if (c == '"')
{
unsigned int j;
for (j = backslashes + 1; j > 0; j--)
*p++ = '\\';
}
*p++ = c;
if (c == '\\')
backslashes++;
else
backslashes = 0;
}
if (quote_around)
{
unsigned int j;
for (j = backslashes; j > 0; j--)
*p++ = '\\';
*p++ = '"';
}
*p = '\0';
new_argv[i] = quoted_string;
}
else
new_argv[i] = (char *) string;
}
new_argv[argc] = NULL;
return new_argv;
}
EOF
;;
esac
cat <<"EOF"
void lt_dump_script (FILE* f)
{
EOF
func_emit_wrapper yes |
$SED -n -e '
s/^\(.\{79\}\)\(..*\)/\1\
\2/
h
s/\([\\"]\)/\\\1/g
s/$/\\n/
s/\([^\n]*\).*/ fputs ("\1", f);/p
g
D'
cat <<"EOF"
}
EOF
}
# end: func_emit_cwrapperexe_src
# func_win32_import_lib_p ARG
# True if ARG is an import lib, as indicated by $file_magic_cmd
func_win32_import_lib_p ()
{
$opt_debug
case `eval $file_magic_cmd \"\$1\" 2>/dev/null | $SED -e 10q` in
*import*) : ;;
*) false ;;
esac
}
# func_mode_link arg...
func_mode_link ()
{
$opt_debug
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
# It is impossible to link a dll without this setting, and
# we shouldn't force the makefile maintainer to figure out
# which system we are compiling for in order to pass an extra
# flag for every libtool invocation.
# allow_undefined=no
# FIXME: Unfortunately, there are problems with the above when trying
# to make a dll which has undefined symbols, in which case not
# even a static library is built. For now, we need to specify
# -no-undefined on the libtool link line when we can be certain
# that all symbols are satisfied, otherwise we get a static library.
allow_undefined=yes
;;
*)
allow_undefined=yes
;;
esac
libtool_args=$nonopt
base_compile="$nonopt $@"
compile_command=$nonopt
finalize_command=$nonopt
compile_rpath=
finalize_rpath=
compile_shlibpath=
finalize_shlibpath=
convenience=
old_convenience=
deplibs=
old_deplibs=
compiler_flags=
linker_flags=
dllsearchpath=
lib_search_path=`pwd`
inst_prefix_dir=
new_inherited_linker_flags=
avoid_version=no
bindir=
dlfiles=
dlprefiles=
dlself=no
export_dynamic=no
export_symbols=
export_symbols_regex=
generated=
libobjs=
ltlibs=
module=no
no_install=no
objs=
non_pic_objects=
precious_files_regex=
prefer_static_libs=no
preload=no
prev=
prevarg=
release=
rpath=
xrpath=
perm_rpath=
temp_rpath=
thread_safe=no
vinfo=
vinfo_number=no
weak_libs=
single_module="${wl}-single_module"
func_infer_tag $base_compile
# We need to know -static, to get the right output filenames.
for arg
do
case $arg in
-shared)
test "$build_libtool_libs" != yes && \
func_fatal_configuration "can not build a shared library"
build_old_libs=no
break
;;
-all-static | -static | -static-libtool-libs)
case $arg in
-all-static)
if test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then
func_warning "complete static linking is impossible in this configuration"
fi
if test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=yes
;;
-static)
if test -z "$pic_flag" && test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=built
;;
-static-libtool-libs)
if test -z "$pic_flag" && test -n "$link_static_flag"; then
dlopen_self=$dlopen_self_static
fi
prefer_static_libs=yes
;;
esac
build_libtool_libs=no
build_old_libs=yes
break
;;
esac
done
# See if our shared archives depend on static archives.
test -n "$old_archive_from_new_cmds" && build_old_libs=yes
# Go through the arguments, transforming them on the way.
while test "$#" -gt 0; do
arg="$1"
shift
func_quote_for_eval "$arg"
qarg=$func_quote_for_eval_unquoted_result
func_append libtool_args " $func_quote_for_eval_result"
# If the previous option needs an argument, assign it.
if test -n "$prev"; then
case $prev in
output)
func_append compile_command " @OUTPUT@"
func_append finalize_command " @OUTPUT@"
;;
esac
case $prev in
bindir)
bindir="$arg"
prev=
continue
;;
dlfiles|dlprefiles)
if test "$preload" = no; then
# Add the symbol object into the linking commands.
func_append compile_command " @SYMFILE@"
func_append finalize_command " @SYMFILE@"
preload=yes
fi
case $arg in
*.la | *.lo) ;; # We handle these cases below.
force)
if test "$dlself" = no; then
dlself=needless
export_dynamic=yes
fi
prev=
continue
;;
self)
if test "$prev" = dlprefiles; then
dlself=yes
elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
dlself=yes
else
dlself=needless
export_dynamic=yes
fi
prev=
continue
;;
*)
if test "$prev" = dlfiles; then
func_append dlfiles " $arg"
else
func_append dlprefiles " $arg"
fi
prev=
continue
;;
esac
;;
expsyms)
export_symbols="$arg"
test -f "$arg" \
|| func_fatal_error "symbol file \`$arg' does not exist"
prev=
continue
;;
expsyms_regex)
export_symbols_regex="$arg"
prev=
continue
;;
framework)
case $host in
*-*-darwin*)
case "$deplibs " in
*" $qarg.ltframework "*) ;;
*) func_append deplibs " $qarg.ltframework" # this is fixed later
;;
esac
;;
esac
prev=
continue
;;
inst_prefix)
inst_prefix_dir="$arg"
prev=
continue
;;
objectlist)
if test -f "$arg"; then
save_arg=$arg
moreargs=
for fil in `cat "$save_arg"`
do
# func_append moreargs " $fil"
arg=$fil
# A libtool-controlled object.
# Check to see that this really is a libtool object.
if func_lalib_unsafe_p "$arg"; then
pic_object=
non_pic_object=
# Read the .lo file
func_source "$arg"
if test -z "$pic_object" ||
test -z "$non_pic_object" ||
test "$pic_object" = none &&
test "$non_pic_object" = none; then
func_fatal_error "cannot find name of object for \`$arg'"
fi
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
if test "$pic_object" != none; then
# Prepend the subdirectory the object is found in.
pic_object="$xdir$pic_object"
if test "$prev" = dlfiles; then
if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
func_append dlfiles " $pic_object"
prev=
continue
else
# If libtool objects are unsupported, then we need to preload.
prev=dlprefiles
fi
fi
# CHECK ME: I think I busted this. -Ossama
if test "$prev" = dlprefiles; then
# Preload the old-style object.
func_append dlprefiles " $pic_object"
prev=
fi
# A PIC object.
func_append libobjs " $pic_object"
arg="$pic_object"
fi
# Non-PIC object.
if test "$non_pic_object" != none; then
# Prepend the subdirectory the object is found in.
non_pic_object="$xdir$non_pic_object"
# A standard non-PIC object
func_append non_pic_objects " $non_pic_object"
if test -z "$pic_object" || test "$pic_object" = none ; then
arg="$non_pic_object"
fi
else
# If the PIC object exists, use it instead.
# $xdir was prepended to $pic_object above.
non_pic_object="$pic_object"
func_append non_pic_objects " $non_pic_object"
fi
else
# Only an error if not doing a dry-run.
if $opt_dry_run; then
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
func_lo2o "$arg"
pic_object=$xdir$objdir/$func_lo2o_result
non_pic_object=$xdir$func_lo2o_result
func_append libobjs " $pic_object"
func_append non_pic_objects " $non_pic_object"
else
func_fatal_error "\`$arg' is not a valid libtool object"
fi
fi
done
else
func_fatal_error "link input file \`$arg' does not exist"
fi
arg=$save_arg
prev=
continue
;;
precious_regex)
precious_files_regex="$arg"
prev=
continue
;;
release)
release="-$arg"
prev=
continue
;;
rpath | xrpath)
# We need an absolute path.
case $arg in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
func_fatal_error "only absolute run-paths are allowed"
;;
esac
if test "$prev" = rpath; then
case "$rpath " in
*" $arg "*) ;;
*) func_append rpath " $arg" ;;
esac
else
case "$xrpath " in
*" $arg "*) ;;
*) func_append xrpath " $arg" ;;
esac
fi
prev=
continue
;;
shrext)
shrext_cmds="$arg"
prev=
continue
;;
weak)
func_append weak_libs " $arg"
prev=
continue
;;
xcclinker)
func_append linker_flags " $qarg"
func_append compiler_flags " $qarg"
prev=
func_append compile_command " $qarg"
func_append finalize_command " $qarg"
continue
;;
xcompiler)
func_append compiler_flags " $qarg"
prev=
func_append compile_command " $qarg"
func_append finalize_command " $qarg"
continue
;;
xlinker)
func_append linker_flags " $qarg"
func_append compiler_flags " $wl$qarg"
prev=
func_append compile_command " $wl$qarg"
func_append finalize_command " $wl$qarg"
continue
;;
*)
eval "$prev=\"\$arg\""
prev=
continue
;;
esac
fi # test -n "$prev"
prevarg="$arg"
case $arg in
-all-static)
if test -n "$link_static_flag"; then
# See comment for -static flag below, for more details.
func_append compile_command " $link_static_flag"
func_append finalize_command " $link_static_flag"
fi
continue
;;
-allow-undefined)
# FIXME: remove this flag sometime in the future.
func_fatal_error "\`-allow-undefined' must not be used because it is the default"
;;
-avoid-version)
avoid_version=yes
continue
;;
-bindir)
prev=bindir
continue
;;
-dlopen)
prev=dlfiles
continue
;;
-dlpreopen)
prev=dlprefiles
continue
;;
-export-dynamic)
export_dynamic=yes
continue
;;
-export-symbols | -export-symbols-regex)
if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
func_fatal_error "more than one -exported-symbols argument is not allowed"
fi
if test "X$arg" = "X-export-symbols"; then
prev=expsyms
else
prev=expsyms_regex
fi
continue
;;
-framework)
prev=framework
continue
;;
-inst-prefix-dir)
prev=inst_prefix
continue
;;
# The native IRIX linker understands -LANG:*, -LIST:* and -LNO:*
# so, if we see these flags be careful not to treat them like -L
-L[A-Z][A-Z]*:*)
case $with_gcc/$host in
no/*-*-irix* | /*-*-irix*)
func_append compile_command " $arg"
func_append finalize_command " $arg"
;;
esac
continue
;;
-L*)
func_stripname "-L" '' "$arg"
if test -z "$func_stripname_result"; then
if test "$#" -gt 0; then
func_fatal_error "require no space between \`-L' and \`$1'"
else
func_fatal_error "need path for \`-L' option"
fi
fi
func_resolve_sysroot "$func_stripname_result"
dir=$func_resolve_sysroot_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
*)
absdir=`cd "$dir" && pwd`
test -z "$absdir" && \
func_fatal_error "cannot determine absolute directory name of \`$dir'"
dir="$absdir"
;;
esac
case "$deplibs " in
*" -L$dir "* | *" $arg "*)
# Will only happen for absolute or sysroot arguments
;;
*)
# Preserve sysroot, but never include relative directories
case $dir in
[\\/]* | [A-Za-z]:[\\/]* | =*) func_append deplibs " $arg" ;;
*) func_append deplibs " -L$dir" ;;
esac
func_append lib_search_path " $dir"
;;
esac
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
testbindir=`$ECHO "$dir" | $SED 's*/lib$*/bin*'`
case :$dllsearchpath: in
*":$dir:"*) ;;
::) dllsearchpath=$dir;;
*) func_append dllsearchpath ":$dir";;
esac
case :$dllsearchpath: in
*":$testbindir:"*) ;;
::) dllsearchpath=$testbindir;;
*) func_append dllsearchpath ":$testbindir";;
esac
;;
esac
continue
;;
-l*)
if test "X$arg" = "X-lc" || test "X$arg" = "X-lm"; then
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos* | *-cegcc* | *-*-haiku*)
# These systems don't actually have a C or math library (as such)
continue
;;
*-*-os2*)
# These systems don't actually have a C library (as such)
test "X$arg" = "X-lc" && continue
;;
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc due to us having libc/libc_r.
test "X$arg" = "X-lc" && continue
;;
*-*-rhapsody* | *-*-darwin1.[012])
# Rhapsody C and math libraries are in the System framework
func_append deplibs " System.ltframework"
continue
;;
*-*-sco3.2v5* | *-*-sco5v6*)
# Causes problems with __ctype
test "X$arg" = "X-lc" && continue
;;
*-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
# Compiler inserts libc in the correct place for threads to work
test "X$arg" = "X-lc" && continue
;;
esac
elif test "X$arg" = "X-lc_r"; then
case $host in
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc_r directly, use -pthread flag.
continue
;;
esac
fi
func_append deplibs " $arg"
continue
;;
-module)
module=yes
continue
;;
# Tru64 UNIX uses -model [arg] to determine the layout of C++
# classes, name mangling, and exception handling.
# Darwin uses the -arch flag to determine output architecture.
-model|-arch|-isysroot|--sysroot)
func_append compiler_flags " $arg"
func_append compile_command " $arg"
func_append finalize_command " $arg"
prev=xcompiler
continue
;;
-mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
|-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
func_append compiler_flags " $arg"
func_append compile_command " $arg"
func_append finalize_command " $arg"
case "$new_inherited_linker_flags " in
*" $arg "*) ;;
* ) func_append new_inherited_linker_flags " $arg" ;;
esac
continue
;;
-multi_module)
single_module="${wl}-multi_module"
continue
;;
-no-fast-install)
fast_install=no
continue
;;
-no-install)
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-darwin* | *-cegcc*)
# The PATH hackery in wrapper scripts is required on Windows
# and Darwin in order for the loader to find any dlls it needs.
func_warning "\`-no-install' is ignored for $host"
func_warning "assuming \`-no-fast-install' instead"
fast_install=no
;;
*) no_install=yes ;;
esac
continue
;;
-no-undefined)
allow_undefined=no
continue
;;
-objectlist)
prev=objectlist
continue
;;
-o) prev=output ;;
-precious-files-regex)
prev=precious_regex
continue
;;
-release)
prev=release
continue
;;
-rpath)
prev=rpath
continue
;;
-R)
prev=xrpath
continue
;;
-R*)
func_stripname '-R' '' "$arg"
dir=$func_stripname_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) ;;
=*)
func_stripname '=' '' "$dir"
dir=$lt_sysroot$func_stripname_result
;;
*)
func_fatal_error "only absolute run-paths are allowed"
;;
esac
case "$xrpath " in
*" $dir "*) ;;
*) func_append xrpath " $dir" ;;
esac
continue
;;
-shared)
# The effects of -shared are defined in a previous loop.
continue
;;
-shrext)
prev=shrext
continue
;;
-static | -static-libtool-libs)
# The effects of -static are defined in a previous loop.
# We used to do the same as -all-static on platforms that
# didn't have a PIC flag, but the assumption that the effects
# would be equivalent was wrong. It would break on at least
# Digital Unix and AIX.
continue
;;
-thread-safe)
thread_safe=yes
continue
;;
-version-info)
prev=vinfo
continue
;;
-version-number)
prev=vinfo
vinfo_number=yes
continue
;;
-weak)
prev=weak
continue
;;
-Wc,*)
func_stripname '-Wc,' '' "$arg"
args=$func_stripname_result
arg=
save_ifs="$IFS"; IFS=','
for flag in $args; do
IFS="$save_ifs"
func_quote_for_eval "$flag"
func_append arg " $func_quote_for_eval_result"
func_append compiler_flags " $func_quote_for_eval_result"
done
IFS="$save_ifs"
func_stripname ' ' '' "$arg"
arg=$func_stripname_result
;;
-Wl,*)
func_stripname '-Wl,' '' "$arg"
args=$func_stripname_result
arg=
save_ifs="$IFS"; IFS=','
for flag in $args; do
IFS="$save_ifs"
func_quote_for_eval "$flag"
func_append arg " $wl$func_quote_for_eval_result"
func_append compiler_flags " $wl$func_quote_for_eval_result"
func_append linker_flags " $func_quote_for_eval_result"
done
IFS="$save_ifs"
func_stripname ' ' '' "$arg"
arg=$func_stripname_result
;;
-Xcompiler)
prev=xcompiler
continue
;;
-Xlinker)
prev=xlinker
continue
;;
-XCClinker)
prev=xcclinker
continue
;;
# -msg_* for osf cc
-msg_*)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
# Flags to be passed through unchanged, with rationale:
# -64, -mips[0-9] enable 64-bit mode for the SGI compiler
# -r[0-9][0-9]* specify processor for the SGI compiler
# -xarch=*, -xtarget=* enable 64-bit mode for the Sun compiler
# +DA*, +DD* enable 64-bit mode for the HP compiler
# -q* compiler args for the IBM compiler
# -m*, -t[45]*, -txscale* architecture-specific flags for GCC
# -F/path path to uninstalled frameworks, gcc on darwin
# -p, -pg, --coverage, -fprofile-* profiling flags for GCC
# @file GCC response files
# -tp=* Portland pgcc target processor selection
# --sysroot=* for sysroot support
# -O*, -flto*, -fwhopr*, -fuse-linker-plugin GCC link-time optimization
-64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*| \
-t[45]*|-txscale*|-p|-pg|--coverage|-fprofile-*|-F*|@*|-tp=*|--sysroot=*| \
-O*|-flto*|-fwhopr*|-fuse-linker-plugin)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
func_append compile_command " $arg"
func_append finalize_command " $arg"
func_append compiler_flags " $arg"
continue
;;
# Some other compiler flag.
-* | +*)
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
*.$objext)
# A standard object.
func_append objs " $arg"
;;
*.lo)
# A libtool-controlled object.
# Check to see that this really is a libtool object.
if func_lalib_unsafe_p "$arg"; then
pic_object=
non_pic_object=
# Read the .lo file
func_source "$arg"
if test -z "$pic_object" ||
test -z "$non_pic_object" ||
test "$pic_object" = none &&
test "$non_pic_object" = none; then
func_fatal_error "cannot find name of object for \`$arg'"
fi
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
if test "$pic_object" != none; then
# Prepend the subdirectory the object is found in.
pic_object="$xdir$pic_object"
if test "$prev" = dlfiles; then
if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
func_append dlfiles " $pic_object"
prev=
continue
else
# If libtool objects are unsupported, then we need to preload.
prev=dlprefiles
fi
fi
# CHECK ME: I think I busted this. -Ossama
if test "$prev" = dlprefiles; then
# Preload the old-style object.
func_append dlprefiles " $pic_object"
prev=
fi
# A PIC object.
func_append libobjs " $pic_object"
arg="$pic_object"
fi
# Non-PIC object.
if test "$non_pic_object" != none; then
# Prepend the subdirectory the object is found in.
non_pic_object="$xdir$non_pic_object"
# A standard non-PIC object
func_append non_pic_objects " $non_pic_object"
if test -z "$pic_object" || test "$pic_object" = none ; then
arg="$non_pic_object"
fi
else
# If the PIC object exists, use it instead.
# $xdir was prepended to $pic_object above.
non_pic_object="$pic_object"
func_append non_pic_objects " $non_pic_object"
fi
else
# Only an error if not doing a dry-run.
if $opt_dry_run; then
# Extract subdirectory from the argument.
func_dirname "$arg" "/" ""
xdir="$func_dirname_result"
func_lo2o "$arg"
pic_object=$xdir$objdir/$func_lo2o_result
non_pic_object=$xdir$func_lo2o_result
func_append libobjs " $pic_object"
func_append non_pic_objects " $non_pic_object"
else
func_fatal_error "\`$arg' is not a valid libtool object"
fi
fi
;;
*.$libext)
# An archive.
func_append deplibs " $arg"
func_append old_deplibs " $arg"
continue
;;
*.la)
# A libtool-controlled library.
func_resolve_sysroot "$arg"
if test "$prev" = dlfiles; then
# This library was specified with -dlopen.
func_append dlfiles " $func_resolve_sysroot_result"
prev=
elif test "$prev" = dlprefiles; then
# The library was specified with -dlpreopen.
func_append dlprefiles " $func_resolve_sysroot_result"
prev=
else
func_append deplibs " $func_resolve_sysroot_result"
fi
continue
;;
# Some other compiler argument.
*)
# Unknown arguments in both finalize_command and compile_command need
# to be aesthetically quoted because they are evaled later.
func_quote_for_eval "$arg"
arg="$func_quote_for_eval_result"
;;
esac # arg
# Now actually substitute the argument into the commands.
if test -n "$arg"; then
func_append compile_command " $arg"
func_append finalize_command " $arg"
fi
done # argument parsing loop
test -n "$prev" && \
func_fatal_help "the \`$prevarg' option requires an argument"
if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
eval arg=\"$export_dynamic_flag_spec\"
func_append compile_command " $arg"
func_append finalize_command " $arg"
fi
oldlibs=
# calculate the name of the file, without its directory
func_basename "$output"
outputname="$func_basename_result"
libobjs_save="$libobjs"
if test -n "$shlibpath_var"; then
# get the directories listed in $shlibpath_var
eval shlib_search_path=\`\$ECHO \"\${$shlibpath_var}\" \| \$SED \'s/:/ /g\'\`
else
shlib_search_path=
fi
eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
func_dirname "$output" "/" ""
output_objdir="$func_dirname_result$objdir"
func_to_tool_file "$output_objdir/"
tool_output_objdir=$func_to_tool_file_result
# Create the object directory.
func_mkdir_p "$output_objdir"
# Determine the type of output
case $output in
"")
func_fatal_help "you must specify an output file"
;;
*.$libext) linkmode=oldlib ;;
*.lo | *.$objext) linkmode=obj ;;
*.la) linkmode=lib ;;
*) linkmode=prog ;; # Anything else should be a program.
esac
specialdeplibs=
libs=
# Find all interdependent deplibs by searching for libraries
# that are linked more than once (e.g. -la -lb -la)
for deplib in $deplibs; do
if $opt_preserve_dup_deps ; then
case "$libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append libs " $deplib"
done
if test "$linkmode" = lib; then
libs="$predeps $libs $compiler_lib_search_path $postdeps"
# Compute libraries that are listed more than once in $predeps
# $postdeps and mark them as special (i.e., whose duplicates are
# not to be eliminated).
pre_post_deps=
if $opt_duplicate_compiler_generated_deps; then
for pre_post_dep in $predeps $postdeps; do
case "$pre_post_deps " in
*" $pre_post_dep "*) func_append specialdeplibs " $pre_post_deps" ;;
esac
func_append pre_post_deps " $pre_post_dep"
done
fi
pre_post_deps=
fi
deplibs=
newdependency_libs=
newlib_search_path=
need_relink=no # whether we're linking any uninstalled libtool libraries
notinst_deplibs= # not-installed libtool libraries
notinst_path= # paths that contain not-installed libtool libraries
case $linkmode in
lib)
passes="conv dlpreopen link"
for file in $dlfiles $dlprefiles; do
case $file in
*.la) ;;
*)
func_fatal_help "libraries can \`-dlopen' only libtool libraries: $file"
;;
esac
done
;;
prog)
compile_deplibs=
finalize_deplibs=
alldeplibs=no
newdlfiles=
newdlprefiles=
passes="conv scan dlopen dlpreopen link"
;;
*) passes="conv"
;;
esac
for pass in $passes; do
# The preopen pass in lib mode reverses $deplibs; put it back here
# so that -L comes before libs that need it for instance...
if test "$linkmode,$pass" = "lib,link"; then
## FIXME: Find the place where the list is rebuilt in the wrong
## order, and fix it there properly
tmp_deplibs=
for deplib in $deplibs; do
tmp_deplibs="$deplib $tmp_deplibs"
done
deplibs="$tmp_deplibs"
fi
if test "$linkmode,$pass" = "lib,link" ||
test "$linkmode,$pass" = "prog,scan"; then
libs="$deplibs"
deplibs=
fi
if test "$linkmode" = prog; then
case $pass in
dlopen) libs="$dlfiles" ;;
dlpreopen) libs="$dlprefiles" ;;
link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
esac
fi
if test "$linkmode,$pass" = "lib,dlpreopen"; then
# Collect and forward deplibs of preopened libtool libs
for lib in $dlprefiles; do
# Ignore non-libtool-libs
dependency_libs=
func_resolve_sysroot "$lib"
case $lib in
*.la) func_source "$func_resolve_sysroot_result" ;;
esac
# Collect preopened libtool deplibs, except any this library
# has declared as weak libs
for deplib in $dependency_libs; do
func_basename "$deplib"
deplib_base=$func_basename_result
case " $weak_libs " in
*" $deplib_base "*) ;;
*) func_append deplibs " $deplib" ;;
esac
done
done
libs="$dlprefiles"
fi
if test "$pass" = dlopen; then
# Collect dlpreopened libraries
save_deplibs="$deplibs"
deplibs=
fi
for deplib in $libs; do
lib=
found=no
case $deplib in
-mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \
|-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*)
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
func_append compiler_flags " $deplib"
if test "$linkmode" = lib ; then
case "$new_inherited_linker_flags " in
*" $deplib "*) ;;
* ) func_append new_inherited_linker_flags " $deplib" ;;
esac
fi
fi
continue
;;
-l*)
if test "$linkmode" != lib && test "$linkmode" != prog; then
func_warning "\`-l' is ignored for archives/objects"
continue
fi
func_stripname '-l' '' "$deplib"
name=$func_stripname_result
if test "$linkmode" = lib; then
searchdirs="$newlib_search_path $lib_search_path $compiler_lib_search_dirs $sys_lib_search_path $shlib_search_path"
else
searchdirs="$newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path"
fi
for searchdir in $searchdirs; do
for search_ext in .la $std_shrext .so .a; do
# Search the libtool library
lib="$searchdir/lib${name}${search_ext}"
if test -f "$lib"; then
if test "$search_ext" = ".la"; then
found=yes
else
found=no
fi
break 2
fi
done
done
if test "$found" != yes; then
# deplib doesn't seem to be a libtool library
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
fi
continue
else # deplib is a libtool library
# If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib,
# We need to do some special things here, and not later.
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
case " $predeps $postdeps " in
*" $deplib "*)
if func_lalib_p "$lib"; then
library_names=
old_library=
func_source "$lib"
for l in $old_library $library_names; do
ll="$l"
done
if test "X$ll" = "X$old_library" ; then # only static version available
found=no
func_dirname "$lib" "" "."
ladir="$func_dirname_result"
lib=$ladir/$old_library
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
test "$linkmode" = lib && newdependency_libs="$deplib $newdependency_libs"
fi
continue
fi
fi
;;
*) ;;
esac
fi
fi
;; # -l
*.ltframework)
if test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
deplibs="$deplib $deplibs"
if test "$linkmode" = lib ; then
case "$new_inherited_linker_flags " in
*" $deplib "*) ;;
* ) func_append new_inherited_linker_flags " $deplib" ;;
esac
fi
fi
continue
;;
-L*)
case $linkmode in
lib)
deplibs="$deplib $deplibs"
test "$pass" = conv && continue
newdependency_libs="$deplib $newdependency_libs"
func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
prog)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
continue
fi
if test "$pass" = scan; then
deplibs="$deplib $deplibs"
else
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
fi
func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
*)
func_warning "\`-L' is ignored for archives/objects"
;;
esac # linkmode
continue
;; # -L
-R*)
if test "$pass" = link; then
func_stripname '-R' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
dir=$func_resolve_sysroot_result
# Make sure the xrpath contains only unique directories.
case "$xrpath " in
*" $dir "*) ;;
*) func_append xrpath " $dir" ;;
esac
fi
deplibs="$deplib $deplibs"
continue
;;
*.la)
func_resolve_sysroot "$deplib"
lib=$func_resolve_sysroot_result
;;
*.$libext)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
continue
fi
case $linkmode in
lib)
# Linking convenience modules into shared libraries is allowed,
# but linking other static libraries is non-portable.
case " $dlpreconveniencelibs " in
*" $deplib "*) ;;
*)
valid_a_lib=no
case $deplibs_check_method in
match_pattern*)
set dummy $deplibs_check_method; shift
match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
if eval "\$ECHO \"$deplib\"" 2>/dev/null | $SED 10q \
| $EGREP "$match_pattern_regex" > /dev/null; then
valid_a_lib=yes
fi
;;
pass_all)
valid_a_lib=yes
;;
esac
if test "$valid_a_lib" != yes; then
echo
$ECHO "*** Warning: Trying to link with static lib archive $deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because the file extensions .$libext of this argument makes me believe"
echo "*** that it is just a static archive that I should not use here."
else
echo
$ECHO "*** Warning: Linking the shared library $output against the"
$ECHO "*** static library $deplib is not portable!"
deplibs="$deplib $deplibs"
fi
;;
esac
continue
;;
prog)
if test "$pass" != link; then
deplibs="$deplib $deplibs"
else
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
fi
continue
;;
esac # linkmode
;; # *.$libext
*.lo | *.$objext)
if test "$pass" = conv; then
deplibs="$deplib $deplibs"
elif test "$linkmode" = prog; then
if test "$pass" = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
# If there is no dlopen support or we're linking statically,
# we need to preload.
func_append newdlprefiles " $deplib"
compile_deplibs="$deplib $compile_deplibs"
finalize_deplibs="$deplib $finalize_deplibs"
else
func_append newdlfiles " $deplib"
fi
fi
continue
;;
%DEPLIBS%)
alldeplibs=yes
continue
;;
esac # case $deplib
if test "$found" = yes || test -f "$lib"; then :
else
func_fatal_error "cannot find the library \`$lib' or unhandled argument \`$deplib'"
fi
# Check to see that this really is a libtool archive.
func_lalib_unsafe_p "$lib" \
|| func_fatal_error "\`$lib' is not a valid libtool archive"
func_dirname "$lib" "" "."
ladir="$func_dirname_result"
dlname=
dlopen=
dlpreopen=
libdir=
library_names=
old_library=
inherited_linker_flags=
# If the library was installed with an old release of libtool,
# it will not redefine variables installed, or shouldnotlink
installed=yes
shouldnotlink=no
avoidtemprpath=
# Read the .la file
func_source "$lib"
# Convert "-framework foo" to "foo.ltframework"
if test -n "$inherited_linker_flags"; then
tmp_inherited_linker_flags=`$ECHO "$inherited_linker_flags" | $SED 's/-framework \([^ $]*\)/\1.ltframework/g'`
for tmp_inherited_linker_flag in $tmp_inherited_linker_flags; do
case " $new_inherited_linker_flags " in
*" $tmp_inherited_linker_flag "*) ;;
*) func_append new_inherited_linker_flags " $tmp_inherited_linker_flag";;
esac
done
fi
dependency_libs=`$ECHO " $dependency_libs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
if test "$linkmode,$pass" = "lib,link" ||
test "$linkmode,$pass" = "prog,scan" ||
{ test "$linkmode" != prog && test "$linkmode" != lib; }; then
test -n "$dlopen" && func_append dlfiles " $dlopen"
test -n "$dlpreopen" && func_append dlprefiles " $dlpreopen"
fi
if test "$pass" = conv; then
# Only check for convenience libraries
deplibs="$lib $deplibs"
if test -z "$libdir"; then
if test -z "$old_library"; then
func_fatal_error "cannot find name of link library for \`$lib'"
fi
# It is a libtool convenience library, so add in its objects.
func_append convenience " $ladir/$objdir/$old_library"
func_append old_convenience " $ladir/$objdir/$old_library"
elif test "$linkmode" != prog && test "$linkmode" != lib; then
func_fatal_error "\`$lib' is not a convenience library"
fi
tmp_libs=
for deplib in $dependency_libs; do
deplibs="$deplib $deplibs"
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append tmp_libs " $deplib"
done
continue
fi # $pass = conv
# Get the name of the library we link against.
linklib=
if test -n "$old_library" &&
{ test "$prefer_static_libs" = yes ||
test "$prefer_static_libs,$installed" = "built,no"; }; then
linklib=$old_library
else
for l in $old_library $library_names; do
linklib="$l"
done
fi
if test -z "$linklib"; then
func_fatal_error "cannot find name of link library for \`$lib'"
fi
# This library was specified with -dlopen.
if test "$pass" = dlopen; then
if test -z "$libdir"; then
func_fatal_error "cannot -dlopen a convenience library: \`$lib'"
fi
if test -z "$dlname" ||
test "$dlopen_support" != yes ||
test "$build_libtool_libs" = no; then
# If there is no dlname, no dlopen support or we're linking
# statically, we need to preload. We also need to preload any
# dependent libraries so libltdl's deplib preloader doesn't
# bomb out in the load deplibs phase.
func_append dlprefiles " $lib $dependency_libs"
else
func_append newdlfiles " $lib"
fi
continue
fi # $pass = dlopen
# We need an absolute path.
case $ladir in
[\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
*)
abs_ladir=`cd "$ladir" && pwd`
if test -z "$abs_ladir"; then
func_warning "cannot determine absolute directory name of \`$ladir'"
func_warning "passing it literally to the linker, although it might fail"
abs_ladir="$ladir"
fi
;;
esac
func_basename "$lib"
laname="$func_basename_result"
# Find the relevant object directory and library name.
if test "X$installed" = Xyes; then
if test ! -f "$lt_sysroot$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
func_warning "library \`$lib' was moved."
dir="$ladir"
absdir="$abs_ladir"
libdir="$abs_ladir"
else
dir="$lt_sysroot$libdir"
absdir="$lt_sysroot$libdir"
fi
test "X$hardcode_automatic" = Xyes && avoidtemprpath=yes
else
if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then
dir="$ladir"
absdir="$abs_ladir"
# Remove this search path later
func_append notinst_path " $abs_ladir"
else
dir="$ladir/$objdir"
absdir="$abs_ladir/$objdir"
# Remove this search path later
func_append notinst_path " $abs_ladir"
fi
fi # $installed = yes
func_stripname 'lib' '.la' "$laname"
name=$func_stripname_result
# This library was specified with -dlpreopen.
if test "$pass" = dlpreopen; then
if test -z "$libdir" && test "$linkmode" = prog; then
func_fatal_error "only libraries may -dlpreopen a convenience library: \`$lib'"
fi
case "$host" in
# special handling for platforms with PE-DLLs.
*cygwin* | *mingw* | *cegcc* )
# Linker will automatically link against shared library if both
# static and shared are present. Therefore, ensure we extract
# symbols from the import library if a shared library is present
# (otherwise, the dlopen module name will be incorrect). We do
# this by putting the import library name into $newdlprefiles.
# We recover the dlopen module name by 'saving' the la file
# name in a special purpose variable, and (later) extracting the
# dlname from the la file.
if test -n "$dlname"; then
func_tr_sh "$dir/$linklib"
eval "libfile_$func_tr_sh_result=\$abs_ladir/\$laname"
func_append newdlprefiles " $dir/$linklib"
else
func_append newdlprefiles " $dir/$old_library"
# Keep a list of preopened convenience libraries to check
# that they are being used correctly in the link pass.
test -z "$libdir" && \
func_append dlpreconveniencelibs " $dir/$old_library"
fi
;;
* )
# Prefer using a static library (so that no silly _DYNAMIC symbols
# are required to link).
if test -n "$old_library"; then
func_append newdlprefiles " $dir/$old_library"
# Keep a list of preopened convenience libraries to check
# that they are being used correctly in the link pass.
test -z "$libdir" && \
func_append dlpreconveniencelibs " $dir/$old_library"
# Otherwise, use the dlname, so that lt_dlopen finds it.
elif test -n "$dlname"; then
func_append newdlprefiles " $dir/$dlname"
else
func_append newdlprefiles " $dir/$linklib"
fi
;;
esac
fi # $pass = dlpreopen
if test -z "$libdir"; then
# Link the convenience library
if test "$linkmode" = lib; then
deplibs="$dir/$old_library $deplibs"
elif test "$linkmode,$pass" = "prog,link"; then
compile_deplibs="$dir/$old_library $compile_deplibs"
finalize_deplibs="$dir/$old_library $finalize_deplibs"
else
deplibs="$lib $deplibs" # used for prog,scan pass
fi
continue
fi
if test "$linkmode" = prog && test "$pass" != link; then
func_append newlib_search_path " $ladir"
deplibs="$lib $deplibs"
linkalldeplibs=no
if test "$link_all_deplibs" != no || test -z "$library_names" ||
test "$build_libtool_libs" = no; then
linkalldeplibs=yes
fi
tmp_libs=
for deplib in $dependency_libs; do
case $deplib in
-L*) func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result"
func_append newlib_search_path " $func_resolve_sysroot_result"
;;
esac
# Need to link against all dependency_libs?
if test "$linkalldeplibs" = yes; then
deplibs="$deplib $deplibs"
else
# Need to hardcode shared library paths
# or/and link against static libraries
newdependency_libs="$deplib $newdependency_libs"
fi
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $deplib "*) func_append specialdeplibs " $deplib" ;;
esac
fi
func_append tmp_libs " $deplib"
done # for deplib
continue
fi # $linkmode = prog...
if test "$linkmode,$pass" = "prog,link"; then
if test -n "$library_names" &&
{ { test "$prefer_static_libs" = no ||
test "$prefer_static_libs,$installed" = "built,yes"; } ||
test -z "$old_library"; }; then
# We need to hardcode the library path
if test -n "$shlibpath_var" && test -z "$avoidtemprpath" ; then
# Make sure the rpath contains only unique directories.
case "$temp_rpath:" in
*"$absdir:"*) ;;
*) func_append temp_rpath "$absdir:" ;;
esac
fi
# Hardcode the library path.
# Skip directories that are in the system default run-time
# search path.
case " $sys_lib_dlsearch_path " in
*" $absdir "*) ;;
*)
case "$compile_rpath " in
*" $absdir "*) ;;
*) func_append compile_rpath " $absdir" ;;
esac
;;
esac
case " $sys_lib_dlsearch_path " in
*" $libdir "*) ;;
*)
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
;;
esac
fi # $linkmode,$pass = prog,link...
if test "$alldeplibs" = yes &&
{ test "$deplibs_check_method" = pass_all ||
{ test "$build_libtool_libs" = yes &&
test -n "$library_names"; }; }; then
# We only need to search for static libraries
continue
fi
fi
link_static=no # Whether the deplib will be linked statically
use_static_libs=$prefer_static_libs
if test "$use_static_libs" = built && test "$installed" = yes; then
use_static_libs=no
fi
if test -n "$library_names" &&
{ test "$use_static_libs" = no || test -z "$old_library"; }; then
case $host in
*cygwin* | *mingw* | *cegcc*)
# No point in relinking DLLs because paths are not encoded
func_append notinst_deplibs " $lib"
need_relink=no
;;
*)
if test "$installed" = no; then
func_append notinst_deplibs " $lib"
need_relink=yes
fi
;;
esac
# This is a shared library
# Warn about portability, can't link against -module's on some
# systems (darwin). Don't bleat about dlopened modules though!
dlopenmodule=""
for dlpremoduletest in $dlprefiles; do
if test "X$dlpremoduletest" = "X$lib"; then
dlopenmodule="$dlpremoduletest"
break
fi
done
if test -z "$dlopenmodule" && test "$shouldnotlink" = yes && test "$pass" = link; then
echo
if test "$linkmode" = prog; then
$ECHO "*** Warning: Linking the executable $output against the loadable module"
else
$ECHO "*** Warning: Linking the shared library $output against the loadable module"
fi
$ECHO "*** $linklib is not portable!"
fi
if test "$linkmode" = lib &&
test "$hardcode_into_libs" = yes; then
# Hardcode the library path.
# Skip directories that are in the system default run-time
# search path.
case " $sys_lib_dlsearch_path " in
*" $absdir "*) ;;
*)
case "$compile_rpath " in
*" $absdir "*) ;;
*) func_append compile_rpath " $absdir" ;;
esac
;;
esac
case " $sys_lib_dlsearch_path " in
*" $libdir "*) ;;
*)
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
;;
esac
fi
if test -n "$old_archive_from_expsyms_cmds"; then
# figure out the soname
set dummy $library_names
shift
realname="$1"
shift
libname=`eval "\\$ECHO \"$libname_spec\""`
# use dlname if we got it. it's perfectly good, no?
if test -n "$dlname"; then
soname="$dlname"
elif test -n "$soname_spec"; then
# bleh windows
case $host in
*cygwin* | mingw* | *cegcc*)
func_arith $current - $age
major=$func_arith_result
versuffix="-$major"
;;
esac
eval soname=\"$soname_spec\"
else
soname="$realname"
fi
# Make a new name for the extract_expsyms_cmds to use
soroot="$soname"
func_basename "$soroot"
soname="$func_basename_result"
func_stripname 'lib' '.dll' "$soname"
newlib=libimp-$func_stripname_result.a
# If the library has no export list, then create one now
if test -f "$output_objdir/$soname-def"; then :
else
func_verbose "extracting exported symbol list from \`$soname'"
func_execute_cmds "$extract_expsyms_cmds" 'exit $?'
fi
# Create $newlib
if test -f "$output_objdir/$newlib"; then :; else
func_verbose "generating import library for \`$soname'"
func_execute_cmds "$old_archive_from_expsyms_cmds" 'exit $?'
fi
# make sure the library variables are pointing to the new library
dir=$output_objdir
linklib=$newlib
fi # test -n "$old_archive_from_expsyms_cmds"
if test "$linkmode" = prog || test "$opt_mode" != relink; then
add_shlibpath=
add_dir=
add=
lib_linked=yes
case $hardcode_action in
immediate | unsupported)
if test "$hardcode_direct" = no; then
add="$dir/$linklib"
case $host in
*-*-sco3.2v5.0.[024]*) add_dir="-L$dir" ;;
*-*-sysv4*uw2*) add_dir="-L$dir" ;;
*-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \
*-*-unixware7*) add_dir="-L$dir" ;;
*-*-darwin* )
# if the lib is a (non-dlopened) module then we can not
# link against it, someone is ignoring the earlier warnings
if /usr/bin/file -L $add 2> /dev/null |
$GREP ": [^:]* bundle" >/dev/null ; then
if test "X$dlopenmodule" != "X$lib"; then
$ECHO "*** Warning: lib $linklib is a module, not a shared library"
if test -z "$old_library" ; then
echo
echo "*** And there doesn't seem to be a static archive available"
echo "*** The link will probably fail, sorry"
else
add="$dir/$old_library"
fi
elif test -n "$old_library"; then
add="$dir/$old_library"
fi
fi
esac
elif test "$hardcode_minus_L" = no; then
case $host in
*-*-sunos*) add_shlibpath="$dir" ;;
esac
add_dir="-L$dir"
add="-l$name"
elif test "$hardcode_shlibpath_var" = no; then
add_shlibpath="$dir"
add="-l$name"
else
lib_linked=no
fi
;;
relink)
if test "$hardcode_direct" = yes &&
test "$hardcode_direct_absolute" = no; then
add="$dir/$linklib"
elif test "$hardcode_minus_L" = yes; then
add_dir="-L$absdir"
# Try looking first in the location we're being installed to.
if test -n "$inst_prefix_dir"; then
case $libdir in
[\\/]*)
func_append add_dir " -L$inst_prefix_dir$libdir"
;;
esac
fi
add="-l$name"
elif test "$hardcode_shlibpath_var" = yes; then
add_shlibpath="$dir"
add="-l$name"
else
lib_linked=no
fi
;;
*) lib_linked=no ;;
esac
if test "$lib_linked" != yes; then
func_fatal_configuration "unsupported hardcode properties"
fi
if test -n "$add_shlibpath"; then
case :$compile_shlibpath: in
*":$add_shlibpath:"*) ;;
*) func_append compile_shlibpath "$add_shlibpath:" ;;
esac
fi
if test "$linkmode" = prog; then
test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
test -n "$add" && compile_deplibs="$add $compile_deplibs"
else
test -n "$add_dir" && deplibs="$add_dir $deplibs"
test -n "$add" && deplibs="$add $deplibs"
if test "$hardcode_direct" != yes &&
test "$hardcode_minus_L" != yes &&
test "$hardcode_shlibpath_var" = yes; then
case :$finalize_shlibpath: in
*":$libdir:"*) ;;
*) func_append finalize_shlibpath "$libdir:" ;;
esac
fi
fi
fi
if test "$linkmode" = prog || test "$opt_mode" = relink; then
add_shlibpath=
add_dir=
add=
# Finalize command for both is simple: just hardcode it.
if test "$hardcode_direct" = yes &&
test "$hardcode_direct_absolute" = no; then
add="$libdir/$linklib"
elif test "$hardcode_minus_L" = yes; then
add_dir="-L$libdir"
add="-l$name"
elif test "$hardcode_shlibpath_var" = yes; then
case :$finalize_shlibpath: in
*":$libdir:"*) ;;
*) func_append finalize_shlibpath "$libdir:" ;;
esac
add="-l$name"
elif test "$hardcode_automatic" = yes; then
if test -n "$inst_prefix_dir" &&
test -f "$inst_prefix_dir$libdir/$linklib" ; then
add="$inst_prefix_dir$libdir/$linklib"
else
add="$libdir/$linklib"
fi
else
# We cannot seem to hardcode it, guess we'll fake it.
add_dir="-L$libdir"
# Try looking first in the location we're being installed to.
if test -n "$inst_prefix_dir"; then
case $libdir in
[\\/]*)
func_append add_dir " -L$inst_prefix_dir$libdir"
;;
esac
fi
add="-l$name"
fi
if test "$linkmode" = prog; then
test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
else
test -n "$add_dir" && deplibs="$add_dir $deplibs"
test -n "$add" && deplibs="$add $deplibs"
fi
fi
elif test "$linkmode" = prog; then
# Here we assume that one of hardcode_direct or hardcode_minus_L
# is not unsupported. This is valid on all known static and
# shared platforms.
if test "$hardcode_direct" != unsupported; then
test -n "$old_library" && linklib="$old_library"
compile_deplibs="$dir/$linklib $compile_deplibs"
finalize_deplibs="$dir/$linklib $finalize_deplibs"
else
compile_deplibs="-l$name -L$dir $compile_deplibs"
finalize_deplibs="-l$name -L$dir $finalize_deplibs"
fi
elif test "$build_libtool_libs" = yes; then
# Not a shared library
if test "$deplibs_check_method" != pass_all; then
# We're trying link a shared library against a static one
# but the system doesn't support it.
# Just print a warning and add the library to dependency_libs so
# that the program can be linked against the static library.
echo
$ECHO "*** Warning: This system can not link to static lib archive $lib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have."
if test "$module" = yes; then
echo "*** But as you try to build a module library, libtool will still create "
echo "*** a static module, that should work as long as the dlopening application"
echo "*** is linked with the -dlopen flag to resolve symbols at runtime."
if test -z "$global_symbol_pipe"; then
echo
echo "*** However, this would only work if libtool was able to extract symbol"
echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
echo "*** not find such a program. So, this module is probably useless."
echo "*** \`nm' from GNU binutils and a full rebuild may help."
fi
if test "$build_old_libs" = no; then
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
fi
else
deplibs="$dir/$old_library $deplibs"
link_static=yes
fi
fi # link shared/static library?
if test "$linkmode" = lib; then
if test -n "$dependency_libs" &&
{ test "$hardcode_into_libs" != yes ||
test "$build_old_libs" = yes ||
test "$link_static" = yes; }; then
# Extract -R from dependency_libs
temp_deplibs=
for libdir in $dependency_libs; do
case $libdir in
-R*) func_stripname '-R' '' "$libdir"
temp_xrpath=$func_stripname_result
case " $xrpath " in
*" $temp_xrpath "*) ;;
*) func_append xrpath " $temp_xrpath";;
esac;;
*) func_append temp_deplibs " $libdir";;
esac
done
dependency_libs="$temp_deplibs"
fi
func_append newlib_search_path " $absdir"
# Link against this library
test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
# ... and its dependency_libs
tmp_libs=
for deplib in $dependency_libs; do
newdependency_libs="$deplib $newdependency_libs"
case $deplib in
-L*) func_stripname '-L' '' "$deplib"
func_resolve_sysroot "$func_stripname_result";;
*) func_resolve_sysroot "$deplib" ;;
esac
if $opt_preserve_dup_deps ; then
case "$tmp_libs " in
*" $func_resolve_sysroot_result "*)
func_append specialdeplibs " $func_resolve_sysroot_result" ;;
esac
fi
func_append tmp_libs " $func_resolve_sysroot_result"
done
if test "$link_all_deplibs" != no; then
# Add the search paths of all dependency libraries
for deplib in $dependency_libs; do
path=
case $deplib in
-L*) path="$deplib" ;;
*.la)
func_resolve_sysroot "$deplib"
deplib=$func_resolve_sysroot_result
func_dirname "$deplib" "" "."
dir=$func_dirname_result
# We need an absolute path.
case $dir in
[\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
*)
absdir=`cd "$dir" && pwd`
if test -z "$absdir"; then
func_warning "cannot determine absolute directory name of \`$dir'"
absdir="$dir"
fi
;;
esac
if $GREP "^installed=no" $deplib > /dev/null; then
case $host in
*-*-darwin*)
depdepl=
eval deplibrary_names=`${SED} -n -e 's/^library_names=\(.*\)$/\1/p' $deplib`
if test -n "$deplibrary_names" ; then
for tmp in $deplibrary_names ; do
depdepl=$tmp
done
if test -f "$absdir/$objdir/$depdepl" ; then
depdepl="$absdir/$objdir/$depdepl"
darwin_install_name=`${OTOOL} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
if test -z "$darwin_install_name"; then
darwin_install_name=`${OTOOL64} -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'`
fi
func_append compiler_flags " ${wl}-dylib_file ${wl}${darwin_install_name}:${depdepl}"
func_append linker_flags " -dylib_file ${darwin_install_name}:${depdepl}"
path=
fi
fi
;;
*)
path="-L$absdir/$objdir"
;;
esac
else
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
test -z "$libdir" && \
func_fatal_error "\`$deplib' is not a valid libtool archive"
test "$absdir" != "$libdir" && \
func_warning "\`$deplib' seems to be moved"
path="-L$absdir"
fi
;;
esac
case " $deplibs " in
*" $path "*) ;;
*) deplibs="$path $deplibs" ;;
esac
done
fi # link_all_deplibs != no
fi # linkmode = lib
done # for deplib in $libs
if test "$pass" = link; then
if test "$linkmode" = "prog"; then
compile_deplibs="$new_inherited_linker_flags $compile_deplibs"
finalize_deplibs="$new_inherited_linker_flags $finalize_deplibs"
else
compiler_flags="$compiler_flags "`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
fi
fi
dependency_libs="$newdependency_libs"
if test "$pass" = dlpreopen; then
# Link the dlpreopened libraries before other libraries
for deplib in $save_deplibs; do
deplibs="$deplib $deplibs"
done
fi
if test "$pass" != dlopen; then
if test "$pass" != conv; then
# Make sure lib_search_path contains only unique directories.
lib_search_path=
for dir in $newlib_search_path; do
case "$lib_search_path " in
*" $dir "*) ;;
*) func_append lib_search_path " $dir" ;;
esac
done
newlib_search_path=
fi
if test "$linkmode,$pass" != "prog,link"; then
vars="deplibs"
else
vars="compile_deplibs finalize_deplibs"
fi
for var in $vars dependency_libs; do
# Add libraries to $var in reverse order
eval tmp_libs=\"\$$var\"
new_libs=
for deplib in $tmp_libs; do
# FIXME: Pedantically, this is the right thing to do, so
# that some nasty dependency loop isn't accidentally
# broken:
#new_libs="$deplib $new_libs"
# Pragmatically, this seems to cause very few problems in
# practice:
case $deplib in
-L*) new_libs="$deplib $new_libs" ;;
-R*) ;;
*)
# And here is the reason: when a library appears more
# than once as an explicit dependence of a library, or
# is implicitly linked in more than once by the
# compiler, it is considered special, and multiple
# occurrences thereof are not removed. Compare this
# with having the same library being listed as a
# dependency of multiple other libraries: in this case,
# we know (pedantically, we assume) the library does not
# need to be listed more than once, so we keep only the
# last copy. This is not always right, but it is rare
# enough that we require users that really mean to play
# such unportable linking tricks to link the library
# using -Wl,-lname, so that libtool does not consider it
# for duplicate removal.
case " $specialdeplibs " in
*" $deplib "*) new_libs="$deplib $new_libs" ;;
*)
case " $new_libs " in
*" $deplib "*) ;;
*) new_libs="$deplib $new_libs" ;;
esac
;;
esac
;;
esac
done
tmp_libs=
for deplib in $new_libs; do
case $deplib in
-L*)
case " $tmp_libs " in
*" $deplib "*) ;;
*) func_append tmp_libs " $deplib" ;;
esac
;;
*) func_append tmp_libs " $deplib" ;;
esac
done
eval $var=\"$tmp_libs\"
done # for var
fi
# Last step: remove runtime libs from dependency_libs
# (they stay in deplibs)
tmp_libs=
for i in $dependency_libs ; do
case " $predeps $postdeps $compiler_lib_search_path " in
*" $i "*)
i=""
;;
esac
if test -n "$i" ; then
func_append tmp_libs " $i"
fi
done
dependency_libs=$tmp_libs
done # for pass
if test "$linkmode" = prog; then
dlfiles="$newdlfiles"
fi
if test "$linkmode" = prog || test "$linkmode" = lib; then
dlprefiles="$newdlprefiles"
fi
case $linkmode in
oldlib)
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
func_warning "\`-dlopen' is ignored for archives"
fi
case " $deplibs" in
*\ -l* | *\ -L*)
func_warning "\`-l' and \`-L' are ignored for archives" ;;
esac
test -n "$rpath" && \
func_warning "\`-rpath' is ignored for archives"
test -n "$xrpath" && \
func_warning "\`-R' is ignored for archives"
test -n "$vinfo" && \
func_warning "\`-version-info/-version-number' is ignored for archives"
test -n "$release" && \
func_warning "\`-release' is ignored for archives"
test -n "$export_symbols$export_symbols_regex" && \
func_warning "\`-export-symbols' is ignored for archives"
# Now set the variables for building old libraries.
build_libtool_libs=no
oldlibs="$output"
func_append objs "$old_deplibs"
;;
lib)
# Make sure we only generate libraries of the form `libNAME.la'.
case $outputname in
lib*)
func_stripname 'lib' '.la' "$outputname"
name=$func_stripname_result
eval shared_ext=\"$shrext_cmds\"
eval libname=\"$libname_spec\"
;;
*)
test "$module" = no && \
func_fatal_help "libtool library \`$output' must begin with \`lib'"
if test "$need_lib_prefix" != no; then
# Add the "lib" prefix for modules if required
func_stripname '' '.la' "$outputname"
name=$func_stripname_result
eval shared_ext=\"$shrext_cmds\"
eval libname=\"$libname_spec\"
else
func_stripname '' '.la' "$outputname"
libname=$func_stripname_result
fi
;;
esac
if test -n "$objs"; then
if test "$deplibs_check_method" != pass_all; then
func_fatal_error "cannot build libtool library \`$output' from non-libtool objects on this host:$objs"
else
echo
$ECHO "*** Warning: Linking the shared library $output against the non-libtool"
$ECHO "*** objects $objs is not portable!"
func_append libobjs " $objs"
fi
fi
test "$dlself" != no && \
func_warning "\`-dlopen self' is ignored for libtool libraries"
set dummy $rpath
shift
test "$#" -gt 1 && \
func_warning "ignoring multiple \`-rpath's for a libtool library"
install_libdir="$1"
oldlibs=
if test -z "$rpath"; then
if test "$build_libtool_libs" = yes; then
# Building a libtool convenience library.
# Some compilers have problems with a `.al' extension so
# convenience libraries should have the same extension an
# archive normally would.
oldlibs="$output_objdir/$libname.$libext $oldlibs"
build_libtool_libs=convenience
build_old_libs=yes
fi
test -n "$vinfo" && \
func_warning "\`-version-info/-version-number' is ignored for convenience libraries"
test -n "$release" && \
func_warning "\`-release' is ignored for convenience libraries"
else
# Parse the version information argument.
save_ifs="$IFS"; IFS=':'
set dummy $vinfo 0 0 0
shift
IFS="$save_ifs"
test -n "$7" && \
func_fatal_help "too many parameters to \`-version-info'"
# convert absolute version numbers to libtool ages
# this retains compatibility with .la files and attempts
# to make the code below a bit more comprehensible
case $vinfo_number in
yes)
number_major="$1"
number_minor="$2"
number_revision="$3"
#
# There are really only two kinds -- those that
# use the current revision as the major version
# and those that subtract age and use age as
# a minor version. But, then there is irix
# which has an extra 1 added just for fun
#
case $version_type in
# correct linux to gnu/linux during the next big refactor
darwin|linux|osf|windows|none)
func_arith $number_major + $number_minor
current=$func_arith_result
age="$number_minor"
revision="$number_revision"
;;
freebsd-aout|freebsd-elf|qnx|sunos)
current="$number_major"
revision="$number_minor"
age="0"
;;
irix|nonstopux)
func_arith $number_major + $number_minor
current=$func_arith_result
age="$number_minor"
revision="$number_minor"
lt_irix_increment=no
;;
esac
;;
no)
current="$1"
revision="$2"
age="$3"
;;
esac
# Check that each of the things are valid numbers.
case $current in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "CURRENT \`$current' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
case $revision in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "REVISION \`$revision' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
case $age in
0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;;
*)
func_error "AGE \`$age' must be a nonnegative integer"
func_fatal_error "\`$vinfo' is not valid version information"
;;
esac
if test "$age" -gt "$current"; then
func_error "AGE \`$age' is greater than the current interface number \`$current'"
func_fatal_error "\`$vinfo' is not valid version information"
fi
# Calculate the version variables.
major=
versuffix=
verstring=
case $version_type in
none) ;;
darwin)
# Like Linux, but with the current version available in
# verstring for coding it into the library header
func_arith $current - $age
major=.$func_arith_result
versuffix="$major.$age.$revision"
# Darwin ld doesn't like 0 for these options...
func_arith $current + 1
minor_current=$func_arith_result
xlcverstring="${wl}-compatibility_version ${wl}$minor_current ${wl}-current_version ${wl}$minor_current.$revision"
verstring="-compatibility_version $minor_current -current_version $minor_current.$revision"
;;
freebsd-aout)
major=".$current"
versuffix=".$current.$revision";
;;
freebsd-elf)
major=".$current"
versuffix=".$current"
;;
irix | nonstopux)
if test "X$lt_irix_increment" = "Xno"; then
func_arith $current - $age
else
func_arith $current - $age + 1
fi
major=$func_arith_result
case $version_type in
nonstopux) verstring_prefix=nonstopux ;;
*) verstring_prefix=sgi ;;
esac
verstring="$verstring_prefix$major.$revision"
# Add in all the interfaces that we are compatible with.
loop=$revision
while test "$loop" -ne 0; do
func_arith $revision - $loop
iface=$func_arith_result
func_arith $loop - 1
loop=$func_arith_result
verstring="$verstring_prefix$major.$iface:$verstring"
done
# Before this point, $major must not contain `.'.
major=.$major
versuffix="$major.$revision"
;;
linux) # correct to gnu/linux during the next big refactor
func_arith $current - $age
major=.$func_arith_result
versuffix="$major.$age.$revision"
;;
osf)
func_arith $current - $age
major=.$func_arith_result
versuffix=".$current.$age.$revision"
verstring="$current.$age.$revision"
# Add in all the interfaces that we are compatible with.
loop=$age
while test "$loop" -ne 0; do
func_arith $current - $loop
iface=$func_arith_result
func_arith $loop - 1
loop=$func_arith_result
verstring="$verstring:${iface}.0"
done
# Make executables depend on our current version.
func_append verstring ":${current}.0"
;;
qnx)
major=".$current"
versuffix=".$current"
;;
sunos)
major=".$current"
versuffix=".$current.$revision"
;;
windows)
# Use '-' rather than '.', since we only want one
# extension on DOS 8.3 filesystems.
func_arith $current - $age
major=$func_arith_result
versuffix="-$major"
;;
*)
func_fatal_configuration "unknown library version type \`$version_type'"
;;
esac
# Clear the version info if we defaulted, and they specified a release.
if test -z "$vinfo" && test -n "$release"; then
major=
case $version_type in
darwin)
# we can't check for "0.0" in archive_cmds due to quoting
# problems, so we reset it completely
verstring=
;;
*)
verstring="0.0"
;;
esac
if test "$need_version" = no; then
versuffix=
else
versuffix=".0.0"
fi
fi
# Remove version info from name if versioning should be avoided
if test "$avoid_version" = yes && test "$need_version" = no; then
major=
versuffix=
verstring=""
fi
# Check to see if the archive will have undefined symbols.
if test "$allow_undefined" = yes; then
if test "$allow_undefined_flag" = unsupported; then
func_warning "undefined symbols not allowed in $host shared libraries"
build_libtool_libs=no
build_old_libs=yes
fi
else
# Don't allow undefined symbols.
allow_undefined_flag="$no_undefined_flag"
fi
fi
func_generate_dlsyms "$libname" "$libname" "yes"
func_append libobjs " $symfileobj"
test "X$libobjs" = "X " && libobjs=
if test "$opt_mode" != relink; then
# Remove our outputs, but don't remove object files since they
# may have been created when compiling PIC objects.
removelist=
tempremovelist=`$ECHO "$output_objdir/*"`
for p in $tempremovelist; do
case $p in
*.$objext | *.gcno)
;;
$output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/${libname}${release}.*)
if test "X$precious_files_regex" != "X"; then
if $ECHO "$p" | $EGREP -e "$precious_files_regex" >/dev/null 2>&1
then
continue
fi
fi
func_append removelist " $p"
;;
*) ;;
esac
done
test -n "$removelist" && \
func_show_eval "${RM}r \$removelist"
fi
# Now set the variables for building old libraries.
if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
func_append oldlibs " $output_objdir/$libname.$libext"
# Transform .lo files to .o files.
oldobjs="$objs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.${libext}$/d; $lo2o" | $NL2SP`
fi
# Eliminate all temporary directories.
#for path in $notinst_path; do
# lib_search_path=`$ECHO "$lib_search_path " | $SED "s% $path % %g"`
# deplibs=`$ECHO "$deplibs " | $SED "s% -L$path % %g"`
# dependency_libs=`$ECHO "$dependency_libs " | $SED "s% -L$path % %g"`
#done
if test -n "$xrpath"; then
# If the user specified any rpath flags, then add them.
temp_xrpath=
for libdir in $xrpath; do
func_replace_sysroot "$libdir"
func_append temp_xrpath " -R$func_replace_sysroot_result"
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
done
if test "$hardcode_into_libs" != yes || test "$build_old_libs" = yes; then
dependency_libs="$temp_xrpath $dependency_libs"
fi
fi
# Make sure dlfiles contains only unique files that won't be dlpreopened
old_dlfiles="$dlfiles"
dlfiles=
for lib in $old_dlfiles; do
case " $dlprefiles $dlfiles " in
*" $lib "*) ;;
*) func_append dlfiles " $lib" ;;
esac
done
# Make sure dlprefiles contains only unique files
old_dlprefiles="$dlprefiles"
dlprefiles=
for lib in $old_dlprefiles; do
case "$dlprefiles " in
*" $lib "*) ;;
*) func_append dlprefiles " $lib" ;;
esac
done
if test "$build_libtool_libs" = yes; then
if test -n "$rpath"; then
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos* | *-cegcc* | *-*-haiku*)
# these systems don't actually have a c library (as such)!
;;
*-*-rhapsody* | *-*-darwin1.[012])
# Rhapsody C library is in the System framework
func_append deplibs " System.ltframework"
;;
*-*-netbsd*)
# Don't link with libc until the a.out ld.so is fixed.
;;
*-*-openbsd* | *-*-freebsd* | *-*-dragonfly*)
# Do not include libc due to us having libc/libc_r.
;;
*-*-sco3.2v5* | *-*-sco5v6*)
# Causes problems with __ctype
;;
*-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*)
# Compiler inserts libc in the correct place for threads to work
;;
*)
# Add libc to deplibs on all other systems if necessary.
if test "$build_libtool_need_lc" = "yes"; then
func_append deplibs " -lc"
fi
;;
esac
fi
# Transform deplibs into only deplibs that can be linked in shared.
name_save=$name
libname_save=$libname
release_save=$release
versuffix_save=$versuffix
major_save=$major
# I'm not sure if I'm treating the release correctly. I think
# release should show up in the -l (ie -lgmp5) so we don't want to
# add it in twice. Is that correct?
release=""
versuffix=""
major=""
newdeplibs=
droppeddeps=no
case $deplibs_check_method in
pass_all)
# Don't check for shared/static. Everything works.
# This might be a little naive. We might want to check
# whether the library exists or not. But this is on
# osf3 & osf4 and I'm not really sure... Just
# implementing what was already the behavior.
newdeplibs=$deplibs
;;
test_compile)
# This code stresses the "libraries are programs" paradigm to its
# limits. Maybe even breaks it. We compile a program, linking it
# against the deplibs as a proxy for the library. Then we can check
# whether they linked in statically or dynamically with ldd.
$opt_dry_run || $RM conftest.c
cat > conftest.c </dev/null`
$nocaseglob
else
potential_libs=`ls $i/$libnameglob[.-]* 2>/dev/null`
fi
for potent_lib in $potential_libs; do
# Follow soft links.
if ls -lLd "$potent_lib" 2>/dev/null |
$GREP " -> " >/dev/null; then
continue
fi
# The statement above tries to avoid entering an
# endless loop below, in case of cyclic links.
# We might still enter an endless loop, since a link
# loop can be closed while we follow links,
# but so what?
potlib="$potent_lib"
while test -h "$potlib" 2>/dev/null; do
potliblink=`ls -ld $potlib | ${SED} 's/.* -> //'`
case $potliblink in
[\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
*) potlib=`$ECHO "$potlib" | $SED 's,[^/]*$,,'`"$potliblink";;
esac
done
if eval $file_magic_cmd \"\$potlib\" 2>/dev/null |
$SED -e 10q |
$EGREP "$file_magic_regex" > /dev/null; then
func_append newdeplibs " $a_deplib"
a_deplib=""
break 2
fi
done
done
fi
if test -n "$a_deplib" ; then
droppeddeps=yes
echo
$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because I did check the linker path looking for a file starting"
if test -z "$potlib" ; then
$ECHO "*** with $libname but no candidates were found. (...for file magic test)"
else
$ECHO "*** with $libname and none of the candidates passed a file format test"
$ECHO "*** using a file magic. Last file checked: $potlib"
fi
fi
;;
*)
# Add a -L argument.
func_append newdeplibs " $a_deplib"
;;
esac
done # Gone through all deplibs.
;;
match_pattern*)
set dummy $deplibs_check_method; shift
match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"`
for a_deplib in $deplibs; do
case $a_deplib in
-l*)
func_stripname -l '' "$a_deplib"
name=$func_stripname_result
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
case " $predeps $postdeps " in
*" $a_deplib "*)
func_append newdeplibs " $a_deplib"
a_deplib=""
;;
esac
fi
if test -n "$a_deplib" ; then
libname=`eval "\\$ECHO \"$libname_spec\""`
for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do
potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
for potent_lib in $potential_libs; do
potlib="$potent_lib" # see symlink-check above in file_magic test
if eval "\$ECHO \"$potent_lib\"" 2>/dev/null | $SED 10q | \
$EGREP "$match_pattern_regex" > /dev/null; then
func_append newdeplibs " $a_deplib"
a_deplib=""
break 2
fi
done
done
fi
if test -n "$a_deplib" ; then
droppeddeps=yes
echo
$ECHO "*** Warning: linker path does not have real file for library $a_deplib."
echo "*** I have the capability to make that library automatically link in when"
echo "*** you link to this library. But I can only do this if you have a"
echo "*** shared version of the library, which you do not appear to have"
echo "*** because I did check the linker path looking for a file starting"
if test -z "$potlib" ; then
$ECHO "*** with $libname but no candidates were found. (...for regex pattern test)"
else
$ECHO "*** with $libname and none of the candidates passed a file format test"
$ECHO "*** using a regex pattern. Last file checked: $potlib"
fi
fi
;;
*)
# Add a -L argument.
func_append newdeplibs " $a_deplib"
;;
esac
done # Gone through all deplibs.
;;
none | unknown | *)
newdeplibs=""
tmp_deplibs=`$ECHO " $deplibs" | $SED 's/ -lc$//; s/ -[LR][^ ]*//g'`
if test "X$allow_libtool_libs_with_static_runtimes" = "Xyes" ; then
for i in $predeps $postdeps ; do
# can't use Xsed below, because $i might contain '/'
tmp_deplibs=`$ECHO " $tmp_deplibs" | $SED "s,$i,,"`
done
fi
case $tmp_deplibs in
*[!\ \ ]*)
echo
if test "X$deplibs_check_method" = "Xnone"; then
echo "*** Warning: inter-library dependencies are not supported in this platform."
else
echo "*** Warning: inter-library dependencies are not known to be supported."
fi
echo "*** All declared inter-library dependencies are being dropped."
droppeddeps=yes
;;
esac
;;
esac
versuffix=$versuffix_save
major=$major_save
release=$release_save
libname=$libname_save
name=$name_save
case $host in
*-*-rhapsody* | *-*-darwin1.[012])
# On Rhapsody replace the C library with the System framework
newdeplibs=`$ECHO " $newdeplibs" | $SED 's/ -lc / System.ltframework /'`
;;
esac
if test "$droppeddeps" = yes; then
if test "$module" = yes; then
echo
echo "*** Warning: libtool could not satisfy all declared inter-library"
$ECHO "*** dependencies of module $libname. Therefore, libtool will create"
echo "*** a static module, that should work as long as the dlopening"
echo "*** application is linked with the -dlopen flag."
if test -z "$global_symbol_pipe"; then
echo
echo "*** However, this would only work if libtool was able to extract symbol"
echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
echo "*** not find such a program. So, this module is probably useless."
echo "*** \`nm' from GNU binutils and a full rebuild may help."
fi
if test "$build_old_libs" = no; then
oldlibs="$output_objdir/$libname.$libext"
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
else
echo "*** The inter-library dependencies that have been dropped here will be"
echo "*** automatically added whenever a program is linked with this library"
echo "*** or is declared to -dlopen it."
if test "$allow_undefined" = no; then
echo
echo "*** Since this library must not contain undefined symbols,"
echo "*** because either the platform does not support them or"
echo "*** it was explicitly requested with -no-undefined,"
echo "*** libtool will only create a static version of it."
if test "$build_old_libs" = no; then
oldlibs="$output_objdir/$libname.$libext"
build_libtool_libs=module
build_old_libs=yes
else
build_libtool_libs=no
fi
fi
fi
fi
# Done checking deplibs!
deplibs=$newdeplibs
fi
# Time to change all our "foo.ltframework" stuff back to "-framework foo"
case $host in
*-*-darwin*)
newdeplibs=`$ECHO " $newdeplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
new_inherited_linker_flags=`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
deplibs=`$ECHO " $deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
;;
esac
# move library search paths that coincide with paths to not yet
# installed libraries to the beginning of the library search list
new_libs=
for path in $notinst_path; do
case " $new_libs " in
*" -L$path/$objdir "*) ;;
*)
case " $deplibs " in
*" -L$path/$objdir "*)
func_append new_libs " -L$path/$objdir" ;;
esac
;;
esac
done
for deplib in $deplibs; do
case $deplib in
-L*)
case " $new_libs " in
*" $deplib "*) ;;
*) func_append new_libs " $deplib" ;;
esac
;;
*) func_append new_libs " $deplib" ;;
esac
done
deplibs="$new_libs"
# All the library-specific variables (install_libdir is set above).
library_names=
old_library=
dlname=
# Test again, we may have decided not to build it any more
if test "$build_libtool_libs" = yes; then
# Remove ${wl} instances when linking with ld.
# FIXME: should test the right _cmds variable.
case $archive_cmds in
*\$LD\ *) wl= ;;
esac
if test "$hardcode_into_libs" = yes; then
# Hardcode the library paths
hardcode_libdirs=
dep_rpath=
rpath="$finalize_rpath"
test "$opt_mode" != relink && rpath="$compile_rpath$rpath"
for libdir in $rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
func_replace_sysroot "$libdir"
libdir=$func_replace_sysroot_result
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append dep_rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$perm_rpath " in
*" $libdir "*) ;;
*) func_append perm_rpath " $libdir" ;;
esac
fi
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval "dep_rpath=\"$hardcode_libdir_flag_spec\""
fi
if test -n "$runpath_var" && test -n "$perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $perm_rpath; do
func_append rpath "$dir:"
done
eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
fi
test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
fi
shlibpath="$finalize_shlibpath"
test "$opt_mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
if test -n "$shlibpath"; then
eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
fi
# Get the real and link names of the library.
eval shared_ext=\"$shrext_cmds\"
eval library_names=\"$library_names_spec\"
set dummy $library_names
shift
realname="$1"
shift
if test -n "$soname_spec"; then
eval soname=\"$soname_spec\"
else
soname="$realname"
fi
if test -z "$dlname"; then
dlname=$soname
fi
lib="$output_objdir/$realname"
linknames=
for link
do
func_append linknames " $link"
done
# Use standard objects if they are pic
test -z "$pic_flag" && libobjs=`$ECHO "$libobjs" | $SP2NL | $SED "$lo2o" | $NL2SP`
test "X$libobjs" = "X " && libobjs=
delfiles=
if test -n "$export_symbols" && test -n "$include_expsyms"; then
$opt_dry_run || cp "$export_symbols" "$output_objdir/$libname.uexp"
export_symbols="$output_objdir/$libname.uexp"
func_append delfiles " $export_symbols"
fi
orig_export_symbols=
case $host_os in
cygwin* | mingw* | cegcc*)
if test -n "$export_symbols" && test -z "$export_symbols_regex"; then
# exporting using user supplied symfile
if test "x`$SED 1q $export_symbols`" != xEXPORTS; then
# and it's NOT already a .def file. Must figure out
# which of the given symbols are data symbols and tag
# them as such. So, trigger use of export_symbols_cmds.
# export_symbols gets reassigned inside the "prepare
# the list of exported symbols" if statement, so the
# include_expsyms logic still works.
orig_export_symbols="$export_symbols"
export_symbols=
always_export_symbols=yes
fi
fi
;;
esac
# Prepare the list of exported symbols
if test -z "$export_symbols"; then
if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
func_verbose "generating symbol list for \`$libname.la'"
export_symbols="$output_objdir/$libname.exp"
$opt_dry_run || $RM $export_symbols
cmds=$export_symbols_cmds
save_ifs="$IFS"; IFS='~'
for cmd1 in $cmds; do
IFS="$save_ifs"
# Take the normal branch if the nm_file_list_spec branch
# doesn't work or if tool conversion is not needed.
case $nm_file_list_spec~$to_tool_file_cmd in
*~func_convert_file_noop | *~func_convert_file_msys_to_w32 | ~*)
try_normal_branch=yes
eval cmd=\"$cmd1\"
func_len " $cmd"
len=$func_len_result
;;
*)
try_normal_branch=no
;;
esac
if test "$try_normal_branch" = yes \
&& { test "$len" -lt "$max_cmd_len" \
|| test "$max_cmd_len" -le -1; }
then
func_show_eval "$cmd" 'exit $?'
skipped_export=false
elif test -n "$nm_file_list_spec"; then
func_basename "$output"
output_la=$func_basename_result
save_libobjs=$libobjs
save_output=$output
output=${output_objdir}/${output_la}.nm
func_to_tool_file "$output"
libobjs=$nm_file_list_spec$func_to_tool_file_result
func_append delfiles " $output"
func_verbose "creating $NM input file list: $output"
for obj in $save_libobjs; do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result"
done > "$output"
eval cmd=\"$cmd1\"
func_show_eval "$cmd" 'exit $?'
output=$save_output
libobjs=$save_libobjs
skipped_export=false
else
# The command line is too long to execute in one step.
func_verbose "using reloadable object file for export list..."
skipped_export=:
# Break out early, otherwise skipped_export may be
# set to false by a later but shorter cmd.
break
fi
done
IFS="$save_ifs"
if test -n "$export_symbols_regex" && test "X$skipped_export" != "X:"; then
func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
fi
fi
fi
if test -n "$export_symbols" && test -n "$include_expsyms"; then
tmp_export_symbols="$export_symbols"
test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
$opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
fi
if test "X$skipped_export" != "X:" && test -n "$orig_export_symbols"; then
# The given exports_symbols file has to be filtered, so filter it.
func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
# FIXME: $output_objdir/$libname.filter potentially contains lots of
# 's' commands which not all seds can handle. GNU sed should be fine
# though. Also, the filter scales superlinearly with the number of
# global variables. join(1) would be nice here, but unfortunately
# isn't a blessed tool.
$opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
func_append delfiles " $export_symbols $output_objdir/$libname.filter"
export_symbols=$output_objdir/$libname.def
$opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
fi
tmp_deplibs=
for test_deplib in $deplibs; do
case " $convenience " in
*" $test_deplib "*) ;;
*)
func_append tmp_deplibs " $test_deplib"
;;
esac
done
deplibs="$tmp_deplibs"
if test -n "$convenience"; then
if test -n "$whole_archive_flag_spec" &&
test "$compiler_needs_object" = yes &&
test -z "$libobjs"; then
# extract the archives, so we have objects to list.
# TODO: could optimize this to just extract one archive.
whole_archive_flag_spec=
fi
if test -n "$whole_archive_flag_spec"; then
save_libobjs=$libobjs
eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
test "X$libobjs" = "X " && libobjs=
else
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $convenience
func_append libobjs " $func_extract_archives_result"
test "X$libobjs" = "X " && libobjs=
fi
fi
if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
eval flag=\"$thread_safe_flag_spec\"
func_append linker_flags " $flag"
fi
# Make a backup of the uninstalled library when relinking
if test "$opt_mode" = relink; then
$opt_dry_run || eval '(cd $output_objdir && $RM ${realname}U && $MV $realname ${realname}U)' || exit $?
fi
# Do each of the archive commands.
if test "$module" = yes && test -n "$module_cmds" ; then
if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
eval test_cmds=\"$module_expsym_cmds\"
cmds=$module_expsym_cmds
else
eval test_cmds=\"$module_cmds\"
cmds=$module_cmds
fi
else
if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
eval test_cmds=\"$archive_expsym_cmds\"
cmds=$archive_expsym_cmds
else
eval test_cmds=\"$archive_cmds\"
cmds=$archive_cmds
fi
fi
if test "X$skipped_export" != "X:" &&
func_len " $test_cmds" &&
len=$func_len_result &&
test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
:
else
# The command line is too long to link in one step, link piecewise
# or, if using GNU ld and skipped_export is not :, use a linker
# script.
# Save the value of $output and $libobjs because we want to
# use them later. If we have whole_archive_flag_spec, we
# want to use save_libobjs as it was before
# whole_archive_flag_spec was expanded, because we can't
# assume the linker understands whole_archive_flag_spec.
# This may have to be revisited, in case too many
# convenience libraries get linked in and end up exceeding
# the spec.
if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then
save_libobjs=$libobjs
fi
save_output=$output
func_basename "$output"
output_la=$func_basename_result
# Clear the reloadable object creation command queue and
# initialize k to one.
test_cmds=
concat_cmds=
objlist=
last_robj=
k=1
if test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "$with_gnu_ld" = yes; then
output=${output_objdir}/${output_la}.lnkscript
func_verbose "creating GNU ld script: $output"
echo 'INPUT (' > $output
for obj in $save_libobjs
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result" >> $output
done
echo ')' >> $output
func_append delfiles " $output"
func_to_tool_file "$output"
output=$func_to_tool_file_result
elif test -n "$save_libobjs" && test "X$skipped_export" != "X:" && test "X$file_list_spec" != X; then
output=${output_objdir}/${output_la}.lnk
func_verbose "creating linker input file list: $output"
: > $output
set x $save_libobjs
shift
firstobj=
if test "$compiler_needs_object" = yes; then
firstobj="$1 "
shift
fi
for obj
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result" >> $output
done
func_append delfiles " $output"
func_to_tool_file "$output"
output=$firstobj\"$file_list_spec$func_to_tool_file_result\"
else
if test -n "$save_libobjs"; then
func_verbose "creating reloadable object files..."
output=$output_objdir/$output_la-${k}.$objext
eval test_cmds=\"$reload_cmds\"
func_len " $test_cmds"
len0=$func_len_result
len=$len0
# Loop over the list of objects to be linked.
for obj in $save_libobjs
do
func_len " $obj"
func_arith $len + $func_len_result
len=$func_arith_result
if test "X$objlist" = X ||
test "$len" -lt "$max_cmd_len"; then
func_append objlist " $obj"
else
# The command $test_cmds is almost too long, add a
# command to the queue.
if test "$k" -eq 1 ; then
# The first file doesn't have a previous command to add.
reload_objs=$objlist
eval concat_cmds=\"$reload_cmds\"
else
# All subsequent reloadable object files will link in
# the last one created.
reload_objs="$objlist $last_robj"
eval concat_cmds=\"\$concat_cmds~$reload_cmds~\$RM $last_robj\"
fi
last_robj=$output_objdir/$output_la-${k}.$objext
func_arith $k + 1
k=$func_arith_result
output=$output_objdir/$output_la-${k}.$objext
objlist=" $obj"
func_len " $last_robj"
func_arith $len0 + $func_len_result
len=$func_arith_result
fi
done
# Handle the remaining objects by creating one last
# reloadable object file. All subsequent reloadable object
# files will link in the last one created.
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
reload_objs="$objlist $last_robj"
eval concat_cmds=\"\${concat_cmds}$reload_cmds\"
if test -n "$last_robj"; then
eval concat_cmds=\"\${concat_cmds}~\$RM $last_robj\"
fi
func_append delfiles " $output"
else
output=
fi
if ${skipped_export-false}; then
func_verbose "generating symbol list for \`$libname.la'"
export_symbols="$output_objdir/$libname.exp"
$opt_dry_run || $RM $export_symbols
libobjs=$output
# Append the command to create the export file.
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
eval concat_cmds=\"\$concat_cmds$export_symbols_cmds\"
if test -n "$last_robj"; then
eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\"
fi
fi
test -n "$save_libobjs" &&
func_verbose "creating a temporary reloadable object file: $output"
# Loop through the commands generated above and execute them.
save_ifs="$IFS"; IFS='~'
for cmd in $concat_cmds; do
IFS="$save_ifs"
$opt_silent || {
func_quote_for_expand "$cmd"
eval "func_echo $func_quote_for_expand_result"
}
$opt_dry_run || eval "$cmd" || {
lt_exit=$?
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
( cd "$output_objdir" && \
$RM "${realname}T" && \
$MV "${realname}U" "$realname" )
fi
exit $lt_exit
}
done
IFS="$save_ifs"
if test -n "$export_symbols_regex" && ${skipped_export-false}; then
func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
func_show_eval '$MV "${export_symbols}T" "$export_symbols"'
fi
fi
if ${skipped_export-false}; then
if test -n "$export_symbols" && test -n "$include_expsyms"; then
tmp_export_symbols="$export_symbols"
test -n "$orig_export_symbols" && tmp_export_symbols="$orig_export_symbols"
$opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"'
fi
if test -n "$orig_export_symbols"; then
# The given exports_symbols file has to be filtered, so filter it.
func_verbose "filter symbol list for \`$libname.la' to tag DATA exports"
# FIXME: $output_objdir/$libname.filter potentially contains lots of
# 's' commands which not all seds can handle. GNU sed should be fine
# though. Also, the filter scales superlinearly with the number of
# global variables. join(1) would be nice here, but unfortunately
# isn't a blessed tool.
$opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter
func_append delfiles " $export_symbols $output_objdir/$libname.filter"
export_symbols=$output_objdir/$libname.def
$opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols
fi
fi
libobjs=$output
# Restore the value of output.
output=$save_output
if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then
eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
test "X$libobjs" = "X " && libobjs=
fi
# Expand the library linking commands again to reset the
# value of $libobjs for piecewise linking.
# Do each of the archive commands.
if test "$module" = yes && test -n "$module_cmds" ; then
if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then
cmds=$module_expsym_cmds
else
cmds=$module_cmds
fi
else
if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
cmds=$archive_expsym_cmds
else
cmds=$archive_cmds
fi
fi
fi
if test -n "$delfiles"; then
# Append the command to remove temporary files to $cmds.
eval cmds=\"\$cmds~\$RM $delfiles\"
fi
# Add any objects from preloaded convenience libraries
if test -n "$dlprefiles"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $dlprefiles
func_append libobjs " $func_extract_archives_result"
test "X$libobjs" = "X " && libobjs=
fi
save_ifs="$IFS"; IFS='~'
for cmd in $cmds; do
IFS="$save_ifs"
eval cmd=\"$cmd\"
$opt_silent || {
func_quote_for_expand "$cmd"
eval "func_echo $func_quote_for_expand_result"
}
$opt_dry_run || eval "$cmd" || {
lt_exit=$?
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
( cd "$output_objdir" && \
$RM "${realname}T" && \
$MV "${realname}U" "$realname" )
fi
exit $lt_exit
}
done
IFS="$save_ifs"
# Restore the uninstalled library and exit
if test "$opt_mode" = relink; then
$opt_dry_run || eval '(cd $output_objdir && $RM ${realname}T && $MV $realname ${realname}T && $MV ${realname}U $realname)' || exit $?
if test -n "$convenience"; then
if test -z "$whole_archive_flag_spec"; then
func_show_eval '${RM}r "$gentop"'
fi
fi
exit $EXIT_SUCCESS
fi
# Create links to the real library.
for linkname in $linknames; do
if test "$realname" != "$linkname"; then
func_show_eval '(cd "$output_objdir" && $RM "$linkname" && $LN_S "$realname" "$linkname")' 'exit $?'
fi
done
# If -module or -export-dynamic was specified, set the dlname.
if test "$module" = yes || test "$export_dynamic" = yes; then
# On all known operating systems, these are identical.
dlname="$soname"
fi
fi
;;
obj)
if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
func_warning "\`-dlopen' is ignored for objects"
fi
case " $deplibs" in
*\ -l* | *\ -L*)
func_warning "\`-l' and \`-L' are ignored for objects" ;;
esac
test -n "$rpath" && \
func_warning "\`-rpath' is ignored for objects"
test -n "$xrpath" && \
func_warning "\`-R' is ignored for objects"
test -n "$vinfo" && \
func_warning "\`-version-info' is ignored for objects"
test -n "$release" && \
func_warning "\`-release' is ignored for objects"
case $output in
*.lo)
test -n "$objs$old_deplibs" && \
func_fatal_error "cannot build library object \`$output' from non-libtool objects"
libobj=$output
func_lo2o "$libobj"
obj=$func_lo2o_result
;;
*)
libobj=
obj="$output"
;;
esac
# Delete the old objects.
$opt_dry_run || $RM $obj $libobj
# Objects from convenience libraries. This assumes
# single-version convenience libraries. Whenever we create
# different ones for PIC/non-PIC, this we'll have to duplicate
# the extraction.
reload_conv_objs=
gentop=
# reload_cmds runs $LD directly, so let us get rid of
# -Wl from whole_archive_flag_spec and hope we can get by with
# turning comma into space..
wl=
if test -n "$convenience"; then
if test -n "$whole_archive_flag_spec"; then
eval tmp_whole_archive_flags=\"$whole_archive_flag_spec\"
reload_conv_objs=$reload_objs\ `$ECHO "$tmp_whole_archive_flags" | $SED 's|,| |g'`
else
gentop="$output_objdir/${obj}x"
func_append generated " $gentop"
func_extract_archives $gentop $convenience
reload_conv_objs="$reload_objs $func_extract_archives_result"
fi
fi
# If we're not building shared, we need to use non_pic_objs
test "$build_libtool_libs" != yes && libobjs="$non_pic_objects"
# Create the old-style object.
reload_objs="$objs$old_deplibs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.${libext}$/d; /\.lib$/d; $lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
output="$obj"
func_execute_cmds "$reload_cmds" 'exit $?'
# Exit if we aren't doing a library object file.
if test -z "$libobj"; then
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
exit $EXIT_SUCCESS
fi
if test "$build_libtool_libs" != yes; then
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
# Create an invalid libtool object if no PIC, so that we don't
# accidentally link it into a program.
# $show "echo timestamp > $libobj"
# $opt_dry_run || eval "echo timestamp > $libobj" || exit $?
exit $EXIT_SUCCESS
fi
if test -n "$pic_flag" || test "$pic_mode" != default; then
# Only do commands if we really have different PIC objects.
reload_objs="$libobjs $reload_conv_objs"
output="$libobj"
func_execute_cmds "$reload_cmds" 'exit $?'
fi
if test -n "$gentop"; then
func_show_eval '${RM}r "$gentop"'
fi
exit $EXIT_SUCCESS
;;
prog)
case $host in
*cygwin*) func_stripname '' '.exe' "$output"
output=$func_stripname_result.exe;;
esac
test -n "$vinfo" && \
func_warning "\`-version-info' is ignored for programs"
test -n "$release" && \
func_warning "\`-release' is ignored for programs"
test "$preload" = yes \
&& test "$dlopen_support" = unknown \
&& test "$dlopen_self" = unknown \
&& test "$dlopen_self_static" = unknown && \
func_warning "\`LT_INIT([dlopen])' not used. Assuming no dlopen support."
case $host in
*-*-rhapsody* | *-*-darwin1.[012])
# On Rhapsody replace the C library is the System framework
compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's/ -lc / System.ltframework /'`
finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's/ -lc / System.ltframework /'`
;;
esac
case $host in
*-*-darwin*)
# Don't allow lazy linking, it breaks C++ global constructors
# But is supposedly fixed on 10.4 or later (yay!).
if test "$tagname" = CXX ; then
case ${MACOSX_DEPLOYMENT_TARGET-10.0} in
10.[0123])
func_append compile_command " ${wl}-bind_at_load"
func_append finalize_command " ${wl}-bind_at_load"
;;
esac
fi
# Time to change all our "foo.ltframework" stuff back to "-framework foo"
compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'`
;;
esac
# move library search paths that coincide with paths to not yet
# installed libraries to the beginning of the library search list
new_libs=
for path in $notinst_path; do
case " $new_libs " in
*" -L$path/$objdir "*) ;;
*)
case " $compile_deplibs " in
*" -L$path/$objdir "*)
func_append new_libs " -L$path/$objdir" ;;
esac
;;
esac
done
for deplib in $compile_deplibs; do
case $deplib in
-L*)
case " $new_libs " in
*" $deplib "*) ;;
*) func_append new_libs " $deplib" ;;
esac
;;
*) func_append new_libs " $deplib" ;;
esac
done
compile_deplibs="$new_libs"
func_append compile_command " $compile_deplibs"
func_append finalize_command " $finalize_deplibs"
if test -n "$rpath$xrpath"; then
# If the user specified any rpath flags, then add them.
for libdir in $rpath $xrpath; do
# This is the magic to use -rpath.
case "$finalize_rpath " in
*" $libdir "*) ;;
*) func_append finalize_rpath " $libdir" ;;
esac
done
fi
# Now hardcode the library paths
rpath=
hardcode_libdirs=
for libdir in $compile_rpath $finalize_rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$perm_rpath " in
*" $libdir "*) ;;
*) func_append perm_rpath " $libdir" ;;
esac
fi
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*)
testbindir=`${ECHO} "$libdir" | ${SED} -e 's*/lib$*/bin*'`
case :$dllsearchpath: in
*":$libdir:"*) ;;
::) dllsearchpath=$libdir;;
*) func_append dllsearchpath ":$libdir";;
esac
case :$dllsearchpath: in
*":$testbindir:"*) ;;
::) dllsearchpath=$testbindir;;
*) func_append dllsearchpath ":$testbindir";;
esac
;;
esac
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval rpath=\" $hardcode_libdir_flag_spec\"
fi
compile_rpath="$rpath"
rpath=
hardcode_libdirs=
for libdir in $finalize_rpath; do
if test -n "$hardcode_libdir_flag_spec"; then
if test -n "$hardcode_libdir_separator"; then
if test -z "$hardcode_libdirs"; then
hardcode_libdirs="$libdir"
else
# Just accumulate the unique libdirs.
case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in
*"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
;;
*)
func_append hardcode_libdirs "$hardcode_libdir_separator$libdir"
;;
esac
fi
else
eval flag=\"$hardcode_libdir_flag_spec\"
func_append rpath " $flag"
fi
elif test -n "$runpath_var"; then
case "$finalize_perm_rpath " in
*" $libdir "*) ;;
*) func_append finalize_perm_rpath " $libdir" ;;
esac
fi
done
# Substitute the hardcoded libdirs into the rpath.
if test -n "$hardcode_libdir_separator" &&
test -n "$hardcode_libdirs"; then
libdir="$hardcode_libdirs"
eval rpath=\" $hardcode_libdir_flag_spec\"
fi
finalize_rpath="$rpath"
if test -n "$libobjs" && test "$build_old_libs" = yes; then
# Transform all the library objects into standard objects.
compile_command=`$ECHO "$compile_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
finalize_command=`$ECHO "$finalize_command" | $SP2NL | $SED "$lo2o" | $NL2SP`
fi
func_generate_dlsyms "$outputname" "@PROGRAM@" "no"
# template prelinking step
if test -n "$prelink_cmds"; then
func_execute_cmds "$prelink_cmds" 'exit $?'
fi
wrappers_required=yes
case $host in
*cegcc* | *mingw32ce*)
# Disable wrappers for cegcc and mingw32ce hosts, we are cross compiling anyway.
wrappers_required=no
;;
*cygwin* | *mingw* )
if test "$build_libtool_libs" != yes; then
wrappers_required=no
fi
;;
*)
if test "$need_relink" = no || test "$build_libtool_libs" != yes; then
wrappers_required=no
fi
;;
esac
if test "$wrappers_required" = no; then
# Replace the output file specification.
compile_command=`$ECHO "$compile_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
link_command="$compile_command$compile_rpath"
# We have no uninstalled library dependencies, so finalize right now.
exit_status=0
func_show_eval "$link_command" 'exit_status=$?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
# Delete the generated files.
if test -f "$output_objdir/${outputname}S.${objext}"; then
func_show_eval '$RM "$output_objdir/${outputname}S.${objext}"'
fi
exit $exit_status
fi
if test -n "$compile_shlibpath$finalize_shlibpath"; then
compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
fi
if test -n "$finalize_shlibpath"; then
finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
fi
compile_var=
finalize_var=
if test -n "$runpath_var"; then
if test -n "$perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $perm_rpath; do
func_append rpath "$dir:"
done
compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
fi
if test -n "$finalize_perm_rpath"; then
# We should set the runpath_var.
rpath=
for dir in $finalize_perm_rpath; do
func_append rpath "$dir:"
done
finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
fi
fi
if test "$no_install" = yes; then
# We don't need to create a wrapper script.
link_command="$compile_var$compile_command$compile_rpath"
# Replace the output file specification.
link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output"'%g'`
# Delete the old output file.
$opt_dry_run || $RM $output
# Link the executable and exit
func_show_eval "$link_command" 'exit $?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
exit $EXIT_SUCCESS
fi
if test "$hardcode_action" = relink; then
# Fast installation is not supported
link_command="$compile_var$compile_command$compile_rpath"
relink_command="$finalize_var$finalize_command$finalize_rpath"
func_warning "this platform does not like uninstalled shared libraries"
func_warning "\`$output' will be relinked during installation"
else
if test "$fast_install" != no; then
link_command="$finalize_var$compile_command$finalize_rpath"
if test "$fast_install" = yes; then
relink_command=`$ECHO "$compile_var$compile_command$compile_rpath" | $SED 's%@OUTPUT@%\$progdir/\$file%g'`
else
# fast_install is set to needless
relink_command=
fi
else
link_command="$compile_var$compile_command$compile_rpath"
relink_command="$finalize_var$finalize_command$finalize_rpath"
fi
fi
# Replace the output file specification.
link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
# Delete the old output files.
$opt_dry_run || $RM $output $output_objdir/$outputname $output_objdir/lt-$outputname
func_show_eval "$link_command" 'exit $?'
if test -n "$postlink_cmds"; then
func_to_tool_file "$output_objdir/$outputname"
postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'`
func_execute_cmds "$postlink_cmds" 'exit $?'
fi
# Now create the wrapper script.
func_verbose "creating $output"
# Quote the relink command for shipping.
if test -n "$relink_command"; then
# Preserve any variables that may affect compiler behavior
for var in $variables_saved_for_relink; do
if eval test -z \"\${$var+set}\"; then
relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
elif eval var_value=\$$var; test -z "$var_value"; then
relink_command="$var=; export $var; $relink_command"
else
func_quote_for_eval "$var_value"
relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
fi
done
relink_command="(cd `pwd`; $relink_command)"
relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"`
fi
# Only actually do things if not in dry run mode.
$opt_dry_run || {
# win32 will think the script is a binary if it has
# a .exe suffix, so we strip it off here.
case $output in
*.exe) func_stripname '' '.exe' "$output"
output=$func_stripname_result ;;
esac
# test for cygwin because mv fails w/o .exe extensions
case $host in
*cygwin*)
exeext=.exe
func_stripname '' '.exe' "$outputname"
outputname=$func_stripname_result ;;
*) exeext= ;;
esac
case $host in
*cygwin* | *mingw* )
func_dirname_and_basename "$output" "" "."
output_name=$func_basename_result
output_path=$func_dirname_result
cwrappersource="$output_path/$objdir/lt-$output_name.c"
cwrapper="$output_path/$output_name.exe"
$RM $cwrappersource $cwrapper
trap "$RM $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15
func_emit_cwrapperexe_src > $cwrappersource
# The wrapper executable is built using the $host compiler,
# because it contains $host paths and files. If cross-
# compiling, it, like the target executable, must be
# executed on the $host or under an emulation environment.
$opt_dry_run || {
$LTCC $LTCFLAGS -o $cwrapper $cwrappersource
$STRIP $cwrapper
}
# Now, create the wrapper script for func_source use:
func_ltwrapper_scriptname $cwrapper
$RM $func_ltwrapper_scriptname_result
trap "$RM $func_ltwrapper_scriptname_result; exit $EXIT_FAILURE" 1 2 15
$opt_dry_run || {
# note: this script will not be executed, so do not chmod.
if test "x$build" = "x$host" ; then
$cwrapper --lt-dump-script > $func_ltwrapper_scriptname_result
else
func_emit_wrapper no > $func_ltwrapper_scriptname_result
fi
}
;;
* )
$RM $output
trap "$RM $output; exit $EXIT_FAILURE" 1 2 15
func_emit_wrapper no > $output
chmod +x $output
;;
esac
}
exit $EXIT_SUCCESS
;;
esac
# See if we need to build an old-fashioned archive.
for oldlib in $oldlibs; do
if test "$build_libtool_libs" = convenience; then
oldobjs="$libobjs_save $symfileobj"
addlibs="$convenience"
build_libtool_libs=no
else
if test "$build_libtool_libs" = module; then
oldobjs="$libobjs_save"
build_libtool_libs=no
else
oldobjs="$old_deplibs $non_pic_objects"
if test "$preload" = yes && test -f "$symfileobj"; then
func_append oldobjs " $symfileobj"
fi
fi
addlibs="$old_convenience"
fi
if test -n "$addlibs"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $addlibs
func_append oldobjs " $func_extract_archives_result"
fi
# Do each command in the archive commands.
if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then
cmds=$old_archive_from_new_cmds
else
# Add any objects from preloaded convenience libraries
if test -n "$dlprefiles"; then
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_extract_archives $gentop $dlprefiles
func_append oldobjs " $func_extract_archives_result"
fi
# POSIX demands no paths to be encoded in archives. We have
# to avoid creating archives with duplicate basenames if we
# might have to extract them afterwards, e.g., when creating a
# static archive out of a convenience library, or when linking
# the entirety of a libtool archive into another (currently
# not supported by libtool).
if (for obj in $oldobjs
do
func_basename "$obj"
$ECHO "$func_basename_result"
done | sort | sort -uc >/dev/null 2>&1); then
:
else
echo "copying selected object files to avoid basename conflicts..."
gentop="$output_objdir/${outputname}x"
func_append generated " $gentop"
func_mkdir_p "$gentop"
save_oldobjs=$oldobjs
oldobjs=
counter=1
for obj in $save_oldobjs
do
func_basename "$obj"
objbase="$func_basename_result"
case " $oldobjs " in
" ") oldobjs=$obj ;;
*[\ /]"$objbase "*)
while :; do
# Make sure we don't pick an alternate name that also
# overlaps.
newobj=lt$counter-$objbase
func_arith $counter + 1
counter=$func_arith_result
case " $oldobjs " in
*[\ /]"$newobj "*) ;;
*) if test ! -f "$gentop/$newobj"; then break; fi ;;
esac
done
func_show_eval "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj"
func_append oldobjs " $gentop/$newobj"
;;
*) func_append oldobjs " $obj" ;;
esac
done
fi
func_to_tool_file "$oldlib" func_convert_file_msys_to_w32
tool_oldlib=$func_to_tool_file_result
eval cmds=\"$old_archive_cmds\"
func_len " $cmds"
len=$func_len_result
if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then
cmds=$old_archive_cmds
elif test -n "$archiver_list_spec"; then
func_verbose "using command file archive linking..."
for obj in $oldobjs
do
func_to_tool_file "$obj"
$ECHO "$func_to_tool_file_result"
done > $output_objdir/$libname.libcmd
func_to_tool_file "$output_objdir/$libname.libcmd"
oldobjs=" $archiver_list_spec$func_to_tool_file_result"
cmds=$old_archive_cmds
else
# the command line is too long to link in one step, link in parts
func_verbose "using piecewise archive linking..."
save_RANLIB=$RANLIB
RANLIB=:
objlist=
concat_cmds=
save_oldobjs=$oldobjs
oldobjs=
# Is there a better way of finding the last object in the list?
for obj in $save_oldobjs
do
last_oldobj=$obj
done
eval test_cmds=\"$old_archive_cmds\"
func_len " $test_cmds"
len0=$func_len_result
len=$len0
for obj in $save_oldobjs
do
func_len " $obj"
func_arith $len + $func_len_result
len=$func_arith_result
func_append objlist " $obj"
if test "$len" -lt "$max_cmd_len"; then
:
else
# the above command should be used before it gets too long
oldobjs=$objlist
if test "$obj" = "$last_oldobj" ; then
RANLIB=$save_RANLIB
fi
test -z "$concat_cmds" || concat_cmds=$concat_cmds~
eval concat_cmds=\"\${concat_cmds}$old_archive_cmds\"
objlist=
len=$len0
fi
done
RANLIB=$save_RANLIB
oldobjs=$objlist
if test "X$oldobjs" = "X" ; then
eval cmds=\"\$concat_cmds\"
else
eval cmds=\"\$concat_cmds~\$old_archive_cmds\"
fi
fi
fi
func_execute_cmds "$cmds" 'exit $?'
done
test -n "$generated" && \
func_show_eval "${RM}r$generated"
# Now create the libtool archive.
case $output in
*.la)
old_library=
test "$build_old_libs" = yes && old_library="$libname.$libext"
func_verbose "creating $output"
# Preserve any variables that may affect compiler behavior
for var in $variables_saved_for_relink; do
if eval test -z \"\${$var+set}\"; then
relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command"
elif eval var_value=\$$var; test -z "$var_value"; then
relink_command="$var=; export $var; $relink_command"
else
func_quote_for_eval "$var_value"
relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command"
fi
done
# Quote the link command for shipping.
relink_command="(cd `pwd`; $SHELL $progpath $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)"
relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"`
if test "$hardcode_automatic" = yes ; then
relink_command=
fi
# Only create the output if not a dry run.
$opt_dry_run || {
for installed in no yes; do
if test "$installed" = yes; then
if test -z "$install_libdir"; then
break
fi
output="$output_objdir/$outputname"i
# Replace all uninstalled libtool libraries with the installed ones
newdependency_libs=
for deplib in $dependency_libs; do
case $deplib in
*.la)
func_basename "$deplib"
name="$func_basename_result"
func_resolve_sysroot "$deplib"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $func_resolve_sysroot_result`
test -z "$libdir" && \
func_fatal_error "\`$deplib' is not a valid libtool archive"
func_append newdependency_libs " ${lt_sysroot:+=}$libdir/$name"
;;
-L*)
func_stripname -L '' "$deplib"
func_replace_sysroot "$func_stripname_result"
func_append newdependency_libs " -L$func_replace_sysroot_result"
;;
-R*)
func_stripname -R '' "$deplib"
func_replace_sysroot "$func_stripname_result"
func_append newdependency_libs " -R$func_replace_sysroot_result"
;;
*) func_append newdependency_libs " $deplib" ;;
esac
done
dependency_libs="$newdependency_libs"
newdlfiles=
for lib in $dlfiles; do
case $lib in
*.la)
func_basename "$lib"
name="$func_basename_result"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
test -z "$libdir" && \
func_fatal_error "\`$lib' is not a valid libtool archive"
func_append newdlfiles " ${lt_sysroot:+=}$libdir/$name"
;;
*) func_append newdlfiles " $lib" ;;
esac
done
dlfiles="$newdlfiles"
newdlprefiles=
for lib in $dlprefiles; do
case $lib in
*.la)
# Only pass preopened files to the pseudo-archive (for
# eventual linking with the app. that links it) if we
# didn't already link the preopened objects directly into
# the library:
func_basename "$lib"
name="$func_basename_result"
eval libdir=`${SED} -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
test -z "$libdir" && \
func_fatal_error "\`$lib' is not a valid libtool archive"
func_append newdlprefiles " ${lt_sysroot:+=}$libdir/$name"
;;
esac
done
dlprefiles="$newdlprefiles"
else
newdlfiles=
for lib in $dlfiles; do
case $lib in
[\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
*) abs=`pwd`"/$lib" ;;
esac
func_append newdlfiles " $abs"
done
dlfiles="$newdlfiles"
newdlprefiles=
for lib in $dlprefiles; do
case $lib in
[\\/]* | [A-Za-z]:[\\/]*) abs="$lib" ;;
*) abs=`pwd`"/$lib" ;;
esac
func_append newdlprefiles " $abs"
done
dlprefiles="$newdlprefiles"
fi
$RM $output
# place dlname in correct position for cygwin
# In fact, it would be nice if we could use this code for all target
# systems that can't hard-code library paths into their executables
# and that have no shared library path variable independent of PATH,
# but it turns out we can't easily determine that from inspecting
# libtool variables, so we have to hard-code the OSs to which it
# applies here; at the moment, that means platforms that use the PE
# object format with DLL files. See the long comment at the top of
# tests/bindir.at for full details.
tdlname=$dlname
case $host,$output,$installed,$module,$dlname in
*cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll | *cegcc*,*lai,yes,no,*.dll)
# If a -bindir argument was supplied, place the dll there.
if test "x$bindir" != x ;
then
func_relative_path "$install_libdir" "$bindir"
tdlname=$func_relative_path_result$dlname
else
# Otherwise fall back on heuristic.
tdlname=../bin/$dlname
fi
;;
esac
$ECHO > $output "\
# $outputname - a libtool library file
# Generated by $PROGRAM (GNU $PACKAGE$TIMESTAMP) $VERSION
#
# Please DO NOT delete this file!
# It is necessary for linking the library.
# The name that we can dlopen(3).
dlname='$tdlname'
# Names of this library.
library_names='$library_names'
# The name of the static archive.
old_library='$old_library'
# Linker flags that can not go in dependency_libs.
inherited_linker_flags='$new_inherited_linker_flags'
# Libraries that this one depends upon.
dependency_libs='$dependency_libs'
# Names of additional weak libraries provided by this library
weak_library_names='$weak_libs'
# Version information for $libname.
current=$current
age=$age
revision=$revision
# Is this an already installed library?
installed=$installed
# Should we warn about portability when linking against -modules?
shouldnotlink=$module
# Files to dlopen/dlpreopen
dlopen='$dlfiles'
dlpreopen='$dlprefiles'
# Directory that this library needs to be installed in:
libdir='$install_libdir'"
if test "$installed" = no && test "$need_relink" = yes; then
$ECHO >> $output "\
relink_command=\"$relink_command\""
fi
done
}
# Do a symbolic link so that the libtool archive can be found in
# LD_LIBRARY_PATH before the program is installed.
func_show_eval '( cd "$output_objdir" && $RM "$outputname" && $LN_S "../$outputname" "$outputname" )' 'exit $?'
;;
esac
exit $EXIT_SUCCESS
}
{ test "$opt_mode" = link || test "$opt_mode" = relink; } &&
func_mode_link ${1+"$@"}
# func_mode_uninstall arg...
func_mode_uninstall ()
{
$opt_debug
RM="$nonopt"
files=
rmforce=
exit_status=0
# This variable tells wrapper scripts just to set variables rather
# than running their programs.
libtool_install_magic="$magic"
for arg
do
case $arg in
-f) func_append RM " $arg"; rmforce=yes ;;
-*) func_append RM " $arg" ;;
*) func_append files " $arg" ;;
esac
done
test -z "$RM" && \
func_fatal_help "you must specify an RM program"
rmdirs=
for file in $files; do
func_dirname "$file" "" "."
dir="$func_dirname_result"
if test "X$dir" = X.; then
odir="$objdir"
else
odir="$dir/$objdir"
fi
func_basename "$file"
name="$func_basename_result"
test "$opt_mode" = uninstall && odir="$dir"
# Remember odir for removal later, being careful to avoid duplicates
if test "$opt_mode" = clean; then
case " $rmdirs " in
*" $odir "*) ;;
*) func_append rmdirs " $odir" ;;
esac
fi
# Don't error if the file doesn't exist and rm -f was used.
if { test -L "$file"; } >/dev/null 2>&1 ||
{ test -h "$file"; } >/dev/null 2>&1 ||
test -f "$file"; then
:
elif test -d "$file"; then
exit_status=1
continue
elif test "$rmforce" = yes; then
continue
fi
rmfiles="$file"
case $name in
*.la)
# Possibly a libtool archive, so verify it.
if func_lalib_p "$file"; then
func_source $dir/$name
# Delete the libtool libraries and symlinks.
for n in $library_names; do
func_append rmfiles " $odir/$n"
done
test -n "$old_library" && func_append rmfiles " $odir/$old_library"
case "$opt_mode" in
clean)
case " $library_names " in
*" $dlname "*) ;;
*) test -n "$dlname" && func_append rmfiles " $odir/$dlname" ;;
esac
test -n "$libdir" && func_append rmfiles " $odir/$name $odir/${name}i"
;;
uninstall)
if test -n "$library_names"; then
# Do each command in the postuninstall commands.
func_execute_cmds "$postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
fi
if test -n "$old_library"; then
# Do each command in the old_postuninstall commands.
func_execute_cmds "$old_postuninstall_cmds" 'test "$rmforce" = yes || exit_status=1'
fi
# FIXME: should reinstall the best remaining shared library.
;;
esac
fi
;;
*.lo)
# Possibly a libtool object, so verify it.
if func_lalib_p "$file"; then
# Read the .lo file
func_source $dir/$name
# Add PIC object to the list of files to remove.
if test -n "$pic_object" &&
test "$pic_object" != none; then
func_append rmfiles " $dir/$pic_object"
fi
# Add non-PIC object to the list of files to remove.
if test -n "$non_pic_object" &&
test "$non_pic_object" != none; then
func_append rmfiles " $dir/$non_pic_object"
fi
fi
;;
*)
if test "$opt_mode" = clean ; then
noexename=$name
case $file in
*.exe)
func_stripname '' '.exe' "$file"
file=$func_stripname_result
func_stripname '' '.exe' "$name"
noexename=$func_stripname_result
# $file with .exe has already been added to rmfiles,
# add $file without .exe
func_append rmfiles " $file"
;;
esac
# Do a test to see if this is a libtool program.
if func_ltwrapper_p "$file"; then
if func_ltwrapper_executable_p "$file"; then
func_ltwrapper_scriptname "$file"
relink_command=
func_source $func_ltwrapper_scriptname_result
func_append rmfiles " $func_ltwrapper_scriptname_result"
else
relink_command=
func_source $dir/$noexename
fi
# note $name still contains .exe if it was in $file originally
# as does the version of $file that was added into $rmfiles
func_append rmfiles " $odir/$name $odir/${name}S.${objext}"
if test "$fast_install" = yes && test -n "$relink_command"; then
func_append rmfiles " $odir/lt-$name"
fi
if test "X$noexename" != "X$name" ; then
func_append rmfiles " $odir/lt-${noexename}.c"
fi
fi
fi
;;
esac
func_show_eval "$RM $rmfiles" 'exit_status=1'
done
# Try to remove the ${objdir}s in the directories where we deleted files
for dir in $rmdirs; do
if test -d "$dir"; then
func_show_eval "rmdir $dir >/dev/null 2>&1"
fi
done
exit $exit_status
}
{ test "$opt_mode" = uninstall || test "$opt_mode" = clean; } &&
func_mode_uninstall ${1+"$@"}
test -z "$opt_mode" && {
help="$generic_help"
func_fatal_help "you must specify a MODE"
}
test -z "$exec_cmd" && \
func_fatal_help "invalid operation mode \`$opt_mode'"
if test -n "$exec_cmd"; then
eval exec "$exec_cmd"
exit $EXIT_FAILURE
fi
exit $exit_status
# The TAGs below are defined such that we never get into a situation
# in which we disable both kinds of libraries. Given conflicting
# choices, we go for a static library, that is the most portable,
# since we can't tell whether shared libraries were disabled because
# the user asked for that or because the platform doesn't support
# them. This is particularly important on AIX, because we don't
# support having both static and shared libraries enabled at the same
# time on that platform, so we default to a shared-only configuration.
# If a disable-shared tag is given, we'll fallback to a static-only
# configuration. But we'll never go from static-only to shared-only.
# ### BEGIN LIBTOOL TAG CONFIG: disable-shared
build_libtool_libs=no
build_old_libs=yes
# ### END LIBTOOL TAG CONFIG: disable-shared
# ### BEGIN LIBTOOL TAG CONFIG: disable-static
build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac`
# ### END LIBTOOL TAG CONFIG: disable-static
# Local Variables:
# mode:shell-script
# sh-indentation:2
# End:
# vi:sw=2
arpack-ng-3.1.5/test-driver 0000755 0001750 0001750 00000007611 12277373057 012524 0000000 0000000 #! /bin/sh
# test-driver - basic testsuite driver script.
scriptversion=2012-06-27.10; # UTC
# Copyright (C) 2011-2013 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see .
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# This file is maintained in Automake, please report
# bugs to or send patches to
# .
# Make unconditional expansion of undefined variables an error. This
# helps a lot in preventing typo-related bugs.
set -u
usage_error ()
{
echo "$0: $*" >&2
print_usage >&2
exit 2
}
print_usage ()
{
cat <$log_file 2>&1
estatus=$?
if test $enable_hard_errors = no && test $estatus -eq 99; then
estatus=1
fi
case $estatus:$expect_failure in
0:yes) col=$red res=XPASS recheck=yes gcopy=yes;;
0:*) col=$grn res=PASS recheck=no gcopy=no;;
77:*) col=$blu res=SKIP recheck=no gcopy=yes;;
99:*) col=$mgn res=ERROR recheck=yes gcopy=yes;;
*:yes) col=$lgn res=XFAIL recheck=no gcopy=yes;;
*:*) col=$red res=FAIL recheck=yes gcopy=yes;;
esac
# Report outcome to console.
echo "${col}${res}${std}: $test_name"
# Register the test result, and other relevant metadata.
echo ":test-result: $res" > $trs_file
echo ":global-test-result: $res" >> $trs_file
echo ":recheck: $recheck" >> $trs_file
echo ":copy-in-global-log: $gcopy" >> $trs_file
# Local Variables:
# mode: shell-script
# sh-indentation: 2
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:
arpack-ng-3.1.5/configure 0000755 0001750 0001750 00002174055 12277667631 012252 0000000 0000000 #! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for arpack-ng 3.1.5.
#
# Report bugs to .
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
# Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
case `(set -o) 2>/dev/null` in #(
*posix*) :
set -o posix ;; #(
*) :
;;
esac
fi
as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
&& (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
as_echo='print -r --'
as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
as_echo='printf %s\n'
as_echo_n='printf %s'
else
if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
as_echo_n='/usr/ucb/echo -n'
else
as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
as_echo_n_body='eval
arg=$1;
case $arg in #(
*"$as_nl"*)
expr "X$arg" : "X\\(.*\\)$as_nl";
arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
esac;
expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
'
export as_echo_n_body
as_echo_n='sh -c $as_echo_n_body as_echo'
fi
export as_echo_body
as_echo='sh -c $as_echo_body as_echo'
fi
# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
PATH_SEPARATOR=:
(PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
(PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
PATH_SEPARATOR=';'
}
fi
# IFS
# We need space, tab and new line, in precisely that order. Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" "" $as_nl"
# Find who we are. Look in the path if we contain no directory separator.
as_myself=
case $0 in #((
*[\\/]* ) as_myself=$0 ;;
*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done
IFS=$as_save_IFS
;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
as_myself=$0
fi
if test ! -f "$as_myself"; then
$as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
exit 1
fi
# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there. '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
&& ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
# Use a proper internal environment variable to ensure we don't fall
# into an infinite loop, continuously re-executing ourselves.
if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
_as_can_reexec=no; export _as_can_reexec;
# We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
*v*x* | *x*v* ) as_opts=-vx ;;
*v* ) as_opts=-v ;;
*x* ) as_opts=-x ;;
* ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
fi
# We don't want this to propagate to other subprocesses.
{ _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
# Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
# is contrary to our usage. Disable this feature.
alias -g '\${1+\"\$@\"}'='\"\$@\"'
setopt NO_GLOB_SUBST
else
case \`(set -o) 2>/dev/null\` in #(
*posix*) :
set -o posix ;; #(
*) :
;;
esac
fi
"
as_required="as_fn_return () { (exit \$1); }
as_fn_success () { as_fn_return 0; }
as_fn_failure () { as_fn_return 1; }
as_fn_ret_success () { return 0; }
as_fn_ret_failure () { return 1; }
exitcode=0
as_fn_success || { exitcode=1; echo as_fn_success failed.; }
as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
else
exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || exit 1
test -x / || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || (
ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO
PATH=/empty FPATH=/empty; export PATH FPATH
test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\
|| test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1
test \$(( 1 + 1 )) = 2 || exit 1"
if (eval "$as_required") 2>/dev/null; then :
as_have_required=yes
else
as_have_required=no
fi
if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
as_found=false
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
as_found=:
case $as_dir in #(
/*)
for as_base in sh bash ksh sh5; do
# Try only shells that exist, to save several forks.
as_shell=$as_dir/$as_base
if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
{ $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
CONFIG_SHELL=$as_shell as_have_required=yes
if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
break 2
fi
fi
done;;
esac
as_found=false
done
$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
{ $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS
if test "x$CONFIG_SHELL" != x; then :
export CONFIG_SHELL
# We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
*v*x* | *x*v* ) as_opts=-vx ;;
*v* ) as_opts=-v ;;
*x* ) as_opts=-x ;;
* ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi
if test x$as_have_required = xno; then :
$as_echo "$0: This script requires a shell more modern than all"
$as_echo "$0: the shells that I found on your system."
if test x${ZSH_VERSION+set} = xset ; then
$as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
$as_echo "$0: be upgraded to zsh 4.3.4 or later."
else
$as_echo "$0: Please tell bug-autoconf@gnu.org and
$0: http://forge.scilab.org/index.php/p/arpack-ng/issues/
$0: about your system, including any error possibly output
$0: before this message. Then install a modern shell, or
$0: manually run the script under such a shell if you do
$0: have one."
fi
exit 1
fi
fi
fi
SHELL=${CONFIG_SHELL-/bin/sh}
export SHELL
# Unset more variables known to interfere with behavior of common tools.
CLICOLOR_FORCE= GREP_OPTIONS=
unset CLICOLOR_FORCE GREP_OPTIONS
## --------------------- ##
## M4sh Shell Functions. ##
## --------------------- ##
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
{ eval $1=; unset $1;}
}
as_unset=as_fn_unset
# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
return $1
} # as_fn_set_status
# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
set +e
as_fn_set_status $1
exit $1
} # as_fn_exit
# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{
case $as_dir in #(
-*) as_dir=./$as_dir;;
esac
test -d "$as_dir" || eval $as_mkdir_p || {
as_dirs=
while :; do
case $as_dir in #(
*\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
*) as_qdir=$as_dir;;
esac
as_dirs="'$as_qdir' $as_dirs"
as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$as_dir" : 'X\(//\)[^/]' \| \
X"$as_dir" : 'X\(//\)$' \| \
X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
test -d "$as_dir" && break
done
test -z "$as_dirs" || eval "mkdir $as_dirs"
} || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
} # as_fn_mkdir_p
# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
eval 'as_fn_append ()
{
eval $1+=\$2
}'
else
as_fn_append ()
{
eval $1=\$$1\$2
}
fi # as_fn_append
# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
eval 'as_fn_arith ()
{
as_val=$(( $* ))
}'
else
as_fn_arith ()
{
as_val=`expr "$@" || test $? -eq 1`
}
fi # as_fn_arith
# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
as_status=$1; test $as_status -eq 0 && as_status=1
if test "$4"; then
as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
$as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
fi
$as_echo "$as_me: error: $2" >&2
as_fn_exit $as_status
} # as_fn_error
if expr a : '\(a\)' >/dev/null 2>&1 &&
test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
as_dirname=dirname
else
as_dirname=false
fi
as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
sed '/^.*\/\([^/][^/]*\)\/*$/{
s//\1/
q
}
/^X\/\(\/\/\)$/{
s//\1/
q
}
/^X\/\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
as_lineno_1=$LINENO as_lineno_1a=$LINENO
as_lineno_2=$LINENO as_lineno_2a=$LINENO
eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
# Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
sed -n '
p
/[$]LINENO/=
' <$as_myself |
sed '
s/[$]LINENO.*/&-/
t lineno
b
:lineno
N
:loop
s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
s/-\n.*//
' >$as_me.lineno &&
chmod +x "$as_me.lineno" ||
{ $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
# If we had to re-execute with $CONFIG_SHELL, we're ensured to have
# already done that, so ensure we don't try to do so again and fall
# in an infinite loop. This has already happened in practice.
_as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
# original and so on. Autoconf is especially sensitive to this).
. "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
-n*)
case `echo 'xy\c'` in
*c*) ECHO_T=' ';; # ECHO_T is single tab character.
xy) ECHO_C='\c';;
*) echo `echo ksh88 bug on AIX 6.1` > /dev/null
ECHO_T=' ';;
esac;;
*)
ECHO_N='-n';;
esac
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
rm -f conf$$.dir/conf$$.file
else
rm -f conf$$.dir
mkdir conf$$.dir 2>/dev/null
fi
if (echo >conf$$.file) 2>/dev/null; then
if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
# In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -pR'
fi
else
as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
as_test_x='test -x'
as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
SHELL=${CONFIG_SHELL-/bin/sh}
test -n "$DJDIR" || exec 7<&0 &1
# Name of the host.
# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
#
# Initializations.
#
ac_default_prefix=/usr/local
ac_clean_files=
ac_config_libobj_dir=.
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='arpack-ng'
PACKAGE_TARNAME='arpack-ng'
PACKAGE_VERSION='3.1.5'
PACKAGE_STRING='arpack-ng 3.1.5'
PACKAGE_BUGREPORT='http://forge.scilab.org/index.php/p/arpack-ng/issues/'
PACKAGE_URL=''
# Factoring default headers for most tests.
ac_includes_default="\
#include
#ifdef HAVE_SYS_TYPES_H
# include
#endif
#ifdef HAVE_SYS_STAT_H
# include
#endif
#ifdef STDC_HEADERS
# include
# include
#else
# ifdef HAVE_STDLIB_H
# include
# endif
#endif
#ifdef HAVE_STRING_H
# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
# include
# endif
# include
#endif
#ifdef HAVE_STRINGS_H
# include
#endif
#ifdef HAVE_INTTYPES_H
# include
#endif
#ifdef HAVE_STDINT_H
# include
#endif
#ifdef HAVE_UNISTD_H
# include
#endif"
ac_subst_vars='am__EXEEXT_FALSE
am__EXEEXT_TRUE
LTLIBOBJS
LIBOBJS
MPI_FALSE
MPI_TRUE
MPILIBS
MPIF77
LAPACK_LIBS
BLAS_LIBS
FLIBS
CPP
OTOOL64
OTOOL
LIPO
NMEDIT
DSYMUTIL
MANIFEST_TOOL
RANLIB
ac_ct_AR
AR
LN_S
NM
ac_ct_DUMPBIN
DUMPBIN
LD
FGREP
EGREP
GREP
SED
am__fastdepCC_FALSE
am__fastdepCC_TRUE
CCDEPMODE
am__nodep
AMDEPBACKSLASH
AMDEP_FALSE
AMDEP_TRUE
am__quote
am__include
DEPDIR
ac_ct_CC
CPPFLAGS
CFLAGS
CC
host_os
host_vendor
host_cpu
host
build_os
build_vendor
build_cpu
build
LIBTOOL
OBJDUMP
DLLTOOL
AS
OBJEXT
EXEEXT
ac_ct_F77
LDFLAGS
FFLAGS
F77
MAINT
MAINTAINER_MODE_FALSE
MAINTAINER_MODE_TRUE
AM_BACKSLASH
AM_DEFAULT_VERBOSITY
AM_DEFAULT_V
AM_V
am__untar
am__tar
AMTAR
am__leading_dot
SET_MAKE
AWK
mkdir_p
MKDIR_P
INSTALL_STRIP_PROGRAM
STRIP
install_sh
MAKEINFO
AUTOHEADER
AUTOMAKE
AUTOCONF
ACLOCAL
VERSION
PACKAGE
CYGPATH_W
am__isrc
INSTALL_DATA
INSTALL_SCRIPT
INSTALL_PROGRAM
target_alias
host_alias
build_alias
LIBS
ECHO_T
ECHO_N
ECHO_C
DEFS
mandir
localedir
libdir
psdir
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir
bindir
program_transform_name
prefix
exec_prefix
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
enable_silent_rules
enable_maintainer_mode
enable_shared
enable_static
with_pic
enable_fast_install
enable_dependency_tracking
with_gnu_ld
with_sysroot
enable_libtool_lock
with_blas
with_lapack
enable_mpi
'
ac_precious_vars='build_alias
host_alias
target_alias
F77
FFLAGS
LDFLAGS
LIBS
CC
CFLAGS
CPPFLAGS
CPP
MPIF77'
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
ac_unrecognized_opts=
ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
exec_prefix=NONE
no_create=
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
verbose=
x_includes=NONE
x_libraries=NONE
# Installation directory options.
# These are left unexpanded so users can "make install exec_prefix=/foo"
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
infodir='${datarootdir}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
mandir='${datarootdir}/man'
ac_prev=
ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval $ac_prev=\$ac_option
ac_prev=
continue
fi
case $ac_option in
*=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
*=) ac_optarg= ;;
*) ac_optarg=yes ;;
esac
# Accept the important Cygnus configure options, so we can diagnose typos.
case $ac_dashdash$ac_option in
--)
ac_dashdash=yes ;;
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
bindir=$ac_optarg ;;
-build | --build | --buil | --bui | --bu)
ac_prev=build_alias ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
build_alias=$ac_optarg ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
cache_file=$ac_optarg ;;
--config-cache | -C)
cache_file=config.cache ;;
-datadir | --datadir | --datadi | --datad)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=*)
datadir=$ac_optarg ;;
-datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
| --dataroo | --dataro | --datar)
ac_prev=datarootdir ;;
-datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
| --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
datarootdir=$ac_optarg ;;
-disable-* | --disable-*)
ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
as_fn_error $? "invalid feature name: $ac_useropt"
ac_useropt_orig=$ac_useropt
ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
case $ac_user_opts in
*"
"enable_$ac_useropt"
"*) ;;
*) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
ac_unrecognized_sep=', ';;
esac
eval enable_$ac_useropt=no ;;
-docdir | --docdir | --docdi | --doc | --do)
ac_prev=docdir ;;
-docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
docdir=$ac_optarg ;;
-dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
ac_prev=dvidir ;;
-dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
dvidir=$ac_optarg ;;
-enable-* | --enable-*)
ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
as_fn_error $? "invalid feature name: $ac_useropt"
ac_useropt_orig=$ac_useropt
ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
case $ac_user_opts in
*"
"enable_$ac_useropt"
"*) ;;
*) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
ac_unrecognized_sep=', ';;
esac
eval enable_$ac_useropt=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
| --exec | --exe | --ex)
ac_prev=exec_prefix ;;
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
exec_prefix=$ac_optarg ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
-help | --help | --hel | --he | -h)
ac_init_help=long ;;
-help=r* | --help=r* | --hel=r* | --he=r* | -hr*)
ac_init_help=recursive ;;
-help=s* | --help=s* | --hel=s* | --he=s* | -hs*)
ac_init_help=short ;;
-host | --host | --hos | --ho)
ac_prev=host_alias ;;
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
-htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
ac_prev=htmldir ;;
-htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
| --ht=*)
htmldir=$ac_optarg ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
includedir=$ac_optarg ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
infodir=$ac_optarg ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
libdir=$ac_optarg ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
-localedir | --localedir | --localedi | --localed | --locale)
ac_prev=localedir ;;
-localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
localedir=$ac_optarg ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst | --locals)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
mandir=$ac_optarg ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c | -n)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
no_recursion=yes ;;
-oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
| --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
| --oldin | --oldi | --old | --ol | --o)
ac_prev=oldincludedir ;;
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
oldincludedir=$ac_optarg ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
prefix=$ac_optarg ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
program_prefix=$ac_optarg ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
program_suffix=$ac_optarg ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
| --program-transform-n | --program-transform- \
| --program-transform | --program-transfor \
| --program-transfo | --program-transf \
| --program-trans | --program-tran \
| --progr-tra | --program-tr | --program-t)
ac_prev=program_transform_name ;;
-program-transform-name=* | --program-transform-name=* \
| --program-transform-nam=* | --program-transform-na=* \
| --program-transform-n=* | --program-transform-=* \
| --program-transform=* | --program-transfor=* \
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
-pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
ac_prev=pdfdir ;;
-pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
pdfdir=$ac_optarg ;;
-psdir | --psdir | --psdi | --psd | --ps)
ac_prev=psdir ;;
-psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
psdir=$ac_optarg ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
sbindir=$ac_optarg ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
| --sharedst | --shareds | --shared | --share | --shar \
| --sha | --sh)
ac_prev=sharedstatedir ;;
-sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
sharedstatedir=$ac_optarg ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
site=$ac_optarg ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir=$ac_optarg ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
sysconfdir=$ac_optarg ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
ac_prev=target_alias ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
target_alias=$ac_optarg ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
-version | --version | --versio | --versi | --vers | -V)
ac_init_version=: ;;
-with-* | --with-*)
ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
as_fn_error $? "invalid package name: $ac_useropt"
ac_useropt_orig=$ac_useropt
ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
case $ac_user_opts in
*"
"with_$ac_useropt"
"*) ;;
*) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
ac_unrecognized_sep=', ';;
esac
eval with_$ac_useropt=\$ac_optarg ;;
-without-* | --without-*)
ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
as_fn_error $? "invalid package name: $ac_useropt"
ac_useropt_orig=$ac_useropt
ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
case $ac_user_opts in
*"
"with_$ac_useropt"
"*) ;;
*) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
ac_unrecognized_sep=', ';;
esac
eval with_$ac_useropt=no ;;
--x)
# Obsolete; use --with-x.
with_x=yes ;;
-x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
| --x-incl | --x-inc | --x-in | --x-i)
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
x_includes=$ac_optarg ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
-*) as_fn_error $? "unrecognized option: \`$ac_option'
Try \`$0 --help' for more information"
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
case $ac_envvar in #(
'' | [0-9]* | *[!_$as_cr_alnum]* )
as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
esac
eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
$as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
$as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
: "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
;;
esac
done
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
as_fn_error $? "missing argument to $ac_option"
fi
if test -n "$ac_unrecognized_opts"; then
case $enable_option_checking in
no) ;;
fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
*) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
esac
fi
# Check all directory arguments for consistency.
for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
datadir sysconfdir sharedstatedir localstatedir includedir \
oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
libdir localedir mandir
do
eval ac_val=\$$ac_var
# Remove trailing slashes.
case $ac_val in
*/ )
ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
eval $ac_var=\$ac_val;;
esac
# Be sure to have absolute directory names.
case $ac_val in
[\\/$]* | ?:[\\/]* ) continue;;
NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
# used to hold the argument of --host etc.
# FIXME: To remove some day.
build=$build_alias
host=$host_alias
target=$target_alias
# FIXME: To remove some day.
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
fi
ac_tool_prefix=
test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
as_fn_error $? "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
as_fn_error $? "pwd does not report name of working directory"
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then the parent directory.
ac_confdir=`$as_dirname -- "$as_myself" ||
$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$as_myself" : 'X\(//\)[^/]' \| \
X"$as_myself" : 'X\(//\)$' \| \
X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_myself" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
srcdir=$ac_confdir
if test ! -r "$srcdir/$ac_unique_file"; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
if test ! -r "$srcdir/$ac_unique_file"; then
test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
fi
ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
ac_abs_confdir=`(
cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
srcdir=.
fi
# Remove unnecessary trailing slashes from srcdir.
# Double slashes in file names in object file debugging info
# mess up M-x gdb in Emacs.
case $srcdir in
*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
esac
for ac_var in $ac_precious_vars; do
eval ac_env_${ac_var}_set=\${${ac_var}+set}
eval ac_env_${ac_var}_value=\$${ac_var}
eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
eval ac_cv_env_${ac_var}_value=\$${ac_var}
done
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
\`configure' configures arpack-ng 3.1.5 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE. See below for descriptions of some of the useful variables.
Defaults for the options are specified in brackets.
Configuration:
-h, --help display this help and exit
--help=short display options specific to this package
--help=recursive display the short help of all the included packages
-V, --version display version information and exit
-q, --quiet, --silent do not print \`checking ...' messages
--cache-file=FILE cache test results in FILE [disabled]
-C, --config-cache alias for \`--cache-file=config.cache'
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
an installation prefix other than \`$ac_default_prefix' using \`--prefix',
for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
--bindir=DIR user executables [EPREFIX/bin]
--sbindir=DIR system admin executables [EPREFIX/sbin]
--libexecdir=DIR program executables [EPREFIX/libexec]
--sysconfdir=DIR read-only single-machine data [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
--localstatedir=DIR modifiable single-machine data [PREFIX/var]
--libdir=DIR object code libraries [EPREFIX/lib]
--includedir=DIR C header files [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc [/usr/include]
--datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
--datadir=DIR read-only architecture-independent data [DATAROOTDIR]
--infodir=DIR info documentation [DATAROOTDIR/info]
--localedir=DIR locale-dependent data [DATAROOTDIR/locale]
--mandir=DIR man documentation [DATAROOTDIR/man]
--docdir=DIR documentation root [DATAROOTDIR/doc/arpack-ng]
--htmldir=DIR html documentation [DOCDIR]
--dvidir=DIR dvi documentation [DOCDIR]
--pdfdir=DIR pdf documentation [DOCDIR]
--psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
Program names:
--program-prefix=PREFIX prepend PREFIX to installed program names
--program-suffix=SUFFIX append SUFFIX to installed program names
--program-transform-name=PROGRAM run sed PROGRAM on installed program names
System types:
--build=BUILD configure for building on BUILD [guessed]
--host=HOST cross-compile to build programs to run on HOST [BUILD]
_ACEOF
fi
if test -n "$ac_init_help"; then
case $ac_init_help in
short | recursive ) echo "Configuration of arpack-ng 3.1.5:";;
esac
cat <<\_ACEOF
Optional Features:
--disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--enable-silent-rules less verbose build output (undo: "make V=1")
--disable-silent-rules verbose build output (undo: "make V=0")
--enable-maintainer-mode
enable make rules and dependencies not useful (and
sometimes confusing) to the casual installer
--enable-shared[=PKGS] build shared libraries [default=yes]
--enable-static[=PKGS] build static libraries [default=yes]
--enable-fast-install[=PKGS]
optimize for fast installation [default=yes]
--enable-dependency-tracking
do not reject slow dependency extractors
--disable-dependency-tracking
speeds up one-time build
--disable-libtool-lock avoid locking (might break parallel builds)
--enable-mpi build parallel version of arpack with MPI
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use
both]
--with-gnu-ld assume the C compiler uses GNU ld [default=no]
--with-sysroot=DIR Search for dependent libraries within DIR
(or the compiler's sysroot if not specified).
--with-blas= use BLAS library
--with-lapack= use LAPACK library
Some influential environment variables:
F77 Fortran 77 compiler command
FFLAGS Fortran 77 compiler flags
LDFLAGS linker flags, e.g. -L if you have libraries in a
nonstandard directory
LIBS libraries to pass to the linker, e.g. -l
CC C compiler command
CFLAGS C compiler flags
CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if
you have headers in a nonstandard directory
CPP C preprocessor
MPIF77 MPI Fortran 77 compiler command
Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.
Report bugs to .
_ACEOF
ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
test -d "$ac_dir" ||
{ cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
continue
ac_builddir=.
case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
# A ".." for each directory in $ac_dir_suffix.
ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
case $ac_top_builddir_sub in
"") ac_top_builddir_sub=. ac_top_build_prefix= ;;
*) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
case $srcdir in
.) # We are building in place.
ac_srcdir=.
ac_top_srcdir=$ac_top_builddir_sub
ac_abs_top_srcdir=$ac_pwd ;;
[\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
ac_top_srcdir=$srcdir
ac_abs_top_srcdir=$srcdir ;;
*) # Relative name.
ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
ac_top_srcdir=$ac_top_build_prefix$srcdir
ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
cd "$ac_dir" || { ac_status=$?; continue; }
# Check for guested configure.
if test -f "$ac_srcdir/configure.gnu"; then
echo &&
$SHELL "$ac_srcdir/configure.gnu" --help=recursive
elif test -f "$ac_srcdir/configure"; then
echo &&
$SHELL "$ac_srcdir/configure" --help=recursive
else
$as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
fi || ac_status=$?
cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
arpack-ng configure 3.1.5
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
exit
fi
## ------------------------ ##
## Autoconf initialization. ##
## ------------------------ ##
# ac_fn_f77_try_compile LINENO
# ----------------------------
# Try to compile conftest.$ac_ext, and return whether this succeeded.
ac_fn_f77_try_compile ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
rm -f conftest.$ac_objext
if { { ac_try="$ac_compile"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compile") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
cat conftest.er1 >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && {
test -z "$ac_f77_werror_flag" ||
test ! -s conftest.err
} && test -s conftest.$ac_objext; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=1
fi
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_f77_try_compile
# ac_fn_c_try_compile LINENO
# --------------------------
# Try to compile conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_compile ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
rm -f conftest.$ac_objext
if { { ac_try="$ac_compile"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compile") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
cat conftest.er1 >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest.$ac_objext; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=1
fi
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_c_try_compile
# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
rm -f conftest.$ac_objext conftest$ac_exeext
if { { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
cat conftest.er1 >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
test -x conftest$ac_exeext
}; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=1
fi
# Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
# created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
# interfere with the next link command; also delete a directory that is
# left behind by Apple's compiler. We do this before executing the actions.
rm -rf conftest.dSYM conftest_ipa8_conftest.oo
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_c_try_link
# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists and can be compiled using the include files in
# INCLUDES, setting the cache variable VAR accordingly.
ac_fn_c_check_header_compile ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$4
#include <$2>
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
eval "$3=yes"
else
eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_header_compile
# ac_fn_c_try_cpp LINENO
# ----------------------
# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_cpp ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
if { { ac_try="$ac_cpp conftest.$ac_ext"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
cat conftest.er1 >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } > conftest.i && {
test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
test ! -s conftest.err
}; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=1
fi
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_c_try_cpp
# ac_fn_c_try_run LINENO
# ----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
# that executables *can* be run.
ac_fn_c_try_run ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
if { { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
{ { case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_try") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; }; then :
ac_retval=0
else
$as_echo "$as_me: program exited with status $ac_status" >&5
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=$ac_status
fi
rm -rf conftest.dSYM conftest_ipa8_conftest.oo
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_c_try_run
# ac_fn_c_check_func LINENO FUNC VAR
# ----------------------------------
# Tests whether FUNC exists, setting the cache variable VAR accordingly
ac_fn_c_check_func ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Define $2 to an innocuous variant, in case declares $2.
For example, HP-UX 11i declares gettimeofday. */
#define $2 innocuous_$2
/* System header to define __stub macros and hopefully few prototypes,
which can conflict with char $2 (); below.
Prefer to if __STDC__ is defined, since
exists even on freestanding compilers. */
#ifdef __STDC__
# include
#else
# include
#endif
#undef $2
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $2 ();
/* The GNU C library defines this for functions which it implements
to always fail with ENOSYS. Some functions are actually named
something starting with __ and the normal name is an alias. */
#if defined __stub_$2 || defined __stub___$2
choke me
#endif
int
main ()
{
return $2 ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$3=yes"
else
eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
eval ac_res=\$$3
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_func
# ac_fn_f77_try_link LINENO
# -------------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_f77_try_link ()
{
as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
rm -f conftest.$ac_objext conftest$ac_exeext
if { { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
grep -v '^ *+' conftest.err >conftest.er1
cat conftest.er1 >&5
mv -f conftest.er1 conftest.err
fi
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && {
test -z "$ac_f77_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
test -x conftest$ac_exeext
}; then :
ac_retval=0
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_retval=1
fi
# Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
# created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
# interfere with the next link command; also delete a directory that is
# left behind by Apple's compiler. We do this before executing the actions.
rm -rf conftest.dSYM conftest_ipa8_conftest.oo
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
as_fn_set_status $ac_retval
} # ac_fn_f77_try_link
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by arpack-ng $as_me 3.1.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##
## --------- ##
hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`
/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
_ASUNAME
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
$as_echo "PATH: $as_dir"
done
IFS=$as_save_IFS
} >&5
cat >&5 <<_ACEOF
## ----------- ##
## Core tests. ##
## ----------- ##
_ACEOF
# Keep a trace of the command line.
# Strip out --no-create and --no-recursion so they do not pile up.
# Strip out --silent because we don't want to record it for future runs.
# Also quote any args containing shell meta-characters.
# Make two passes to allow for proper duplicate-argument suppression.
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
ac_must_keep_next=false
for ac_pass in 1 2
do
for ac_arg
do
case $ac_arg in
-no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
*\'*)
ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
2)
as_fn_append ac_configure_args1 " '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
case $ac_arg in
*=* | --config-cache | -C | -disable-* | --disable-* \
| -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
| -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
| -with-* | --with-* | -without-* | --without-* | --x)
case "$ac_configure_args0 " in
"$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
esac
;;
-* ) ac_must_keep_next=true ;;
esac
fi
as_fn_append ac_configure_args " '$ac_arg'"
;;
esac
done
done
{ ac_configure_args0=; unset ac_configure_args0;}
{ ac_configure_args1=; unset ac_configure_args1;}
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
# WARNING: Use '\'' to represent an apostrophe within the trap.
# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
echo
$as_echo "## ---------------- ##
## Cache variables. ##
## ---------------- ##"
echo
# The following way of writing the cache mishandles newlines in values,
(
for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
eval ac_val=\$$ac_var
case $ac_val in #(
*${as_nl}*)
case $ac_var in #(
*_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
esac
case $ac_var in #(
_ | IFS | as_nl) ;; #(
BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
*) { eval $ac_var=; unset $ac_var;} ;;
esac ;;
esac
done
(set) 2>&1 |
case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
*${as_nl}ac_space=\ *)
sed -n \
"s/'\''/'\''\\\\'\'''\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
;; #(
*)
sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
esac |
sort
)
echo
$as_echo "## ----------------- ##
## Output variables. ##
## ----------------- ##"
echo
for ac_var in $ac_subst_vars
do
eval ac_val=\$$ac_var
case $ac_val in
*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
esac
$as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
if test -n "$ac_subst_files"; then
$as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
echo
for ac_var in $ac_subst_files
do
eval ac_val=\$$ac_var
case $ac_val in
*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
esac
$as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
if test -s confdefs.h; then
$as_echo "## ----------- ##
## confdefs.h. ##
## ----------- ##"
echo
cat confdefs.h
echo
fi
test "$ac_signal" != 0 &&
$as_echo "$as_me: caught signal $ac_signal"
$as_echo "$as_me: exit $exit_status"
} >&5
rm -f core *.core core.conftest.* &&
rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
' 0
for ac_signal in 1 2 13 15; do
trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -f -r conftest* confdefs.h
$as_echo "/* confdefs.h */" > confdefs.h
# Predefined preprocessor variables.
cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF
# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
# We do not want a PATH search for config.site.
case $CONFIG_SITE in #((
-*) ac_site_file1=./$CONFIG_SITE;;
*/*) ac_site_file1=$CONFIG_SITE;;
*) ac_site_file1=./$CONFIG_SITE;;
esac
elif test "x$prefix" != xNONE; then
ac_site_file1=$prefix/share/config.site
ac_site_file2=$prefix/etc/config.site
else
ac_site_file1=$ac_default_prefix/share/config.site
ac_site_file2=$ac_default_prefix/etc/config.site
fi
for ac_site_file in "$ac_site_file1" "$ac_site_file2"
do
test "x$ac_site_file" = xNONE && continue
if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
. "$ac_site_file" \
|| { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "failed to load site script $ac_site_file
See \`config.log' for more details" "$LINENO" 5; }
fi
done
if test -r "$cache_file"; then
# Some versions of bash will fail to source /dev/null (special files
# actually), so we avoid doing that. DJGPP emulates it as a regular file.
if test /dev/null != "$cache_file" && test -f "$cache_file"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
[\\/]* | ?:[\\/]* ) . "$cache_file";;
*) . "./$cache_file";;
esac
fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
for ac_var in $ac_precious_vars; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
eval ac_old_val=\$ac_cv_env_${ac_var}_value
eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
{ $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
{ $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
# differences in whitespace do not lead to failure.
ac_old_val_w=`echo x $ac_old_val`
ac_new_val_w=`echo x $ac_new_val`
if test "$ac_old_val_w" != "$ac_new_val_w"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
ac_cache_corrupted=:
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
eval $ac_var=\$ac_old_val
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
{ $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
*\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
*) as_fn_append ac_configure_args " '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
{ $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
## -------------------- ##
## Main body of script. ##
## -------------------- ##
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
am__api_version='1.14'
ac_aux_dir=
for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do
if test -f "$ac_dir/install-sh"; then
ac_aux_dir=$ac_dir
ac_install_sh="$ac_aux_dir/install-sh -c"
break
elif test -f "$ac_dir/install.sh"; then
ac_aux_dir=$ac_dir
ac_install_sh="$ac_aux_dir/install.sh -c"
break
elif test -f "$ac_dir/shtool"; then
ac_aux_dir=$ac_dir
ac_install_sh="$ac_aux_dir/shtool install -c"
break
fi
done
if test -z "$ac_aux_dir"; then
as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5
fi
# These three variables are undocumented and unsupported,
# and are intended to be withdrawn in a future Autoconf release.
# They can cause serious problems if a builder's source tree is in a directory
# whose full name contains unusual characters.
ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var.
ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var.
ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var.
# Find a good install program. We prefer a C program (faster),
# so one script is as good as another. But avoid the broken or
# incompatible versions:
# SysV /etc/install, /usr/sbin/install
# SunOS /usr/etc/install
# IRIX /sbin/install
# AIX /bin/install
# AmigaOS /C/install, which installs bootblocks on floppy discs
# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
# AFS /usr/afsws/bin/install, which mishandles nonexistent args
# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
# OS/2's system install, which has a completely different semantic
# ./install, which can be erroneously created by make from ./install.sh.
# Reject install programs that cannot install multiple files.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
$as_echo_n "checking for a BSD-compatible install... " >&6; }
if test -z "$INSTALL"; then
if ${ac_cv_path_install+:} false; then :
$as_echo_n "(cached) " >&6
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
# Account for people who put trailing slashes in PATH elements.
case $as_dir/ in #((
./ | .// | /[cC]/* | \
/etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
/usr/ucb/* ) ;;
*)
# OSF1 and SCO ODT 3.0 have their own names for install.
# Don't use installbsd from OSF since it installs stuff as root
# by default.
for ac_prog in ginstall scoinst install; do
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
if test $ac_prog = install &&
grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
# AIX install. It has an incompatible calling convention.
:
elif test $ac_prog = install &&
grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
# program-specific install script used by HP pwplus--don't use.
:
else
rm -rf conftest.one conftest.two conftest.dir
echo one > conftest.one
echo two > conftest.two
mkdir conftest.dir
if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
test -s conftest.one && test -s conftest.two &&
test -s conftest.dir/conftest.one &&
test -s conftest.dir/conftest.two
then
ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
break 3
fi
fi
fi
done
done
;;
esac
done
IFS=$as_save_IFS
rm -rf conftest.one conftest.two conftest.dir
fi
if test "${ac_cv_path_install+set}" = set; then
INSTALL=$ac_cv_path_install
else
# As a last resort, use the slow shell script. Don't cache a
# value for INSTALL within a source directory, because that will
# break other packages using the cache if that directory is
# removed, or if the value is a relative name.
INSTALL=$ac_install_sh
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
$as_echo "$INSTALL" >&6; }
# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
# It thinks the first close brace ends the variable substitution.
test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5
$as_echo_n "checking whether build environment is sane... " >&6; }
# Reject unsafe characters in $srcdir or the absolute working directory
# name. Accept space and tab only in the latter.
am_lf='
'
case `pwd` in
*[\\\"\#\$\&\'\`$am_lf]*)
as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;;
esac
case $srcdir in
*[\\\"\#\$\&\'\`$am_lf\ \ ]*)
as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;;
esac
# Do 'set' in a subshell so we don't clobber the current shell's
# arguments. Must try -L first in case configure is actually a
# symlink; some systems play weird games with the mod time of symlinks
# (eg FreeBSD returns the mod time of the symlink's containing
# directory).
if (
am_has_slept=no
for am_try in 1 2; do
echo "timestamp, slept: $am_has_slept" > conftest.file
set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null`
if test "$*" = "X"; then
# -L didn't work.
set X `ls -t "$srcdir/configure" conftest.file`
fi
if test "$*" != "X $srcdir/configure conftest.file" \
&& test "$*" != "X conftest.file $srcdir/configure"; then
# If neither matched, then we have a broken ls. This can happen
# if, for instance, CONFIG_SHELL is bash and it inherits a
# broken ls alias from the environment. This has actually
# happened. Such a system could not be considered "sane".
as_fn_error $? "ls -t appears to fail. Make sure there is not a broken
alias in your environment" "$LINENO" 5
fi
if test "$2" = conftest.file || test $am_try -eq 2; then
break
fi
# Just in case.
sleep 1
am_has_slept=yes
done
test "$2" = conftest.file
)
then
# Ok.
:
else
as_fn_error $? "newly created file is older than distributed files!
Check your system clock" "$LINENO" 5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
# If we didn't sleep, we still need to ensure time stamps of config.status and
# generated files are strictly newer.
am_sleep_pid=
if grep 'slept: no' conftest.file >/dev/null 2>&1; then
( sleep 1 ) &
am_sleep_pid=$!
fi
rm -f conftest.file
test "$program_prefix" != NONE &&
program_transform_name="s&^&$program_prefix&;$program_transform_name"
# Use a double $ so make ignores it.
test "$program_suffix" != NONE &&
program_transform_name="s&\$&$program_suffix&;$program_transform_name"
# Double any \ or $.
# By default was `s,x,x', remove it if useless.
ac_script='s/[\\$]/&&/g;s/;s,x,x,$//'
program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"`
# expand $ac_aux_dir to an absolute path
am_aux_dir=`cd $ac_aux_dir && pwd`
if test x"${MISSING+set}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;;
*)
MISSING="\${SHELL} $am_aux_dir/missing" ;;
esac
fi
# Use eval to expand $SHELL
if eval "$MISSING --is-lightweight"; then
am_missing_run="$MISSING "
else
am_missing_run=
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5
$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;}
fi
if test x"${install_sh}" != xset; then
case $am_aux_dir in
*\ * | *\ *)
install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;;
*)
install_sh="\${SHELL} $am_aux_dir/install-sh"
esac
fi
# Installed binaries are usually stripped using 'strip' when the user
# run "make install-strip". However 'strip' might not be the right
# tool to use in cross-compilation environments, therefore Automake
# will honor the 'STRIP' environment variable to overrule this program.
if test "$cross_compiling" != no; then
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
set dummy ${ac_tool_prefix}strip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_STRIP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$STRIP"; then
ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_STRIP="${ac_tool_prefix}strip"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
STRIP=$ac_cv_prog_STRIP
if test -n "$STRIP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5
$as_echo "$STRIP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_STRIP"; then
ac_ct_STRIP=$STRIP
# Extract the first word of "strip", so it can be a program name with args.
set dummy strip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_STRIP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_STRIP"; then
ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_STRIP="strip"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
if test -n "$ac_ct_STRIP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5
$as_echo "$ac_ct_STRIP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_STRIP" = x; then
STRIP=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
STRIP=$ac_ct_STRIP
fi
else
STRIP="$ac_cv_prog_STRIP"
fi
fi
INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5
$as_echo_n "checking for a thread-safe mkdir -p... " >&6; }
if test -z "$MKDIR_P"; then
if ${ac_cv_path_mkdir+:} false; then :
$as_echo_n "(cached) " >&6
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_prog in mkdir gmkdir; do
for ac_exec_ext in '' $ac_executable_extensions; do
as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue
case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #(
'mkdir (GNU coreutils) '* | \
'mkdir (coreutils) '* | \
'mkdir (fileutils) '4.1*)
ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext
break 3;;
esac
done
done
done
IFS=$as_save_IFS
fi
test -d ./--version && rmdir ./--version
if test "${ac_cv_path_mkdir+set}" = set; then
MKDIR_P="$ac_cv_path_mkdir -p"
else
# As a last resort, use the slow shell script. Don't cache a
# value for MKDIR_P within a source directory, because that will
# break other packages using the cache if that directory is
# removed, or if the value is a relative name.
MKDIR_P="$ac_install_sh -d"
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5
$as_echo "$MKDIR_P" >&6; }
for ac_prog in gawk mawk nawk awk
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AWK+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$AWK"; then
ac_cv_prog_AWK="$AWK" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AWK="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
AWK=$ac_cv_prog_AWK
if test -n "$AWK"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5
$as_echo "$AWK" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$AWK" && break
done
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
set x ${MAKE-make}
ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :
$as_echo_n "(cached) " >&6
else
cat >conftest.make <<\_ACEOF
SHELL = /bin/sh
all:
@echo '@@@%%%=$(MAKE)=@@@%%%'
_ACEOF
# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
case `${MAKE-make} -f conftest.make 2>/dev/null` in
*@@@%%%=?*=@@@%%%*)
eval ac_cv_prog_make_${ac_make}_set=yes;;
*)
eval ac_cv_prog_make_${ac_make}_set=no;;
esac
rm -f conftest.make
fi
if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
SET_MAKE=
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
SET_MAKE="MAKE=${MAKE-make}"
fi
rm -rf .tst 2>/dev/null
mkdir .tst 2>/dev/null
if test -d .tst; then
am__leading_dot=.
else
am__leading_dot=_
fi
rmdir .tst 2>/dev/null
# Check whether --enable-silent-rules was given.
if test "${enable_silent_rules+set}" = set; then :
enableval=$enable_silent_rules;
fi
case $enable_silent_rules in # (((
yes) AM_DEFAULT_VERBOSITY=0;;
no) AM_DEFAULT_VERBOSITY=1;;
*) AM_DEFAULT_VERBOSITY=1;;
esac
am_make=${MAKE-make}
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5
$as_echo_n "checking whether $am_make supports nested variables... " >&6; }
if ${am_cv_make_support_nested_variables+:} false; then :
$as_echo_n "(cached) " >&6
else
if $as_echo 'TRUE=$(BAR$(V))
BAR0=false
BAR1=true
V=1
am__doit:
@$(TRUE)
.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then
am_cv_make_support_nested_variables=yes
else
am_cv_make_support_nested_variables=no
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5
$as_echo "$am_cv_make_support_nested_variables" >&6; }
if test $am_cv_make_support_nested_variables = yes; then
AM_V='$(V)'
AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)'
else
AM_V=$AM_DEFAULT_VERBOSITY
AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY
fi
AM_BACKSLASH='\'
if test "`cd $srcdir && pwd`" != "`pwd`"; then
# Use -I$(srcdir) only when $(srcdir) != ., so that make's output
# is not polluted with repeated "-I."
am__isrc=' -I$(srcdir)'
# test to see if srcdir already configured
if test -f $srcdir/config.status; then
as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5
fi
fi
# test whether we have cygpath
if test -z "$CYGPATH_W"; then
if (cygpath --version) >/dev/null 2>/dev/null; then
CYGPATH_W='cygpath -w'
else
CYGPATH_W=echo
fi
fi
# Define the identity of the package.
PACKAGE='arpack-ng'
VERSION='3.1.5'
cat >>confdefs.h <<_ACEOF
#define PACKAGE "$PACKAGE"
_ACEOF
cat >>confdefs.h <<_ACEOF
#define VERSION "$VERSION"
_ACEOF
# Some tools Automake needs.
ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"}
AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"}
AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"}
AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"}
MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
# For better backward compatibility. To be removed once Automake 1.9.x
# dies out for good. For more background, see:
#
#
mkdir_p='$(MKDIR_P)'
# We need awk for the "check" target. The system "awk" is bad on
# some platforms.
# Always define AMTAR for backward compatibility. Yes, it's still used
# in the wild :-( We should find a proper way to deprecate it ...
AMTAR='$${TAR-tar}'
# We'll loop over all known methods to create a tar archive until one works.
_am_tools='gnutar pax cpio none'
am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'
# POSIX will say in a future version that running "rm -f" with no argument
# is OK; and we want to be able to make that assumption in our Makefile
# recipes. So use an aggressive probe to check that the usage we want is
# actually supported "in the wild" to an acceptable degree.
# See automake bug#10828.
# To make any issue more visible, cause the running configure to be aborted
# by default if the 'rm' program in use doesn't match our expectations; the
# user can still override this though.
if rm -f && rm -fr && rm -rf; then : OK; else
cat >&2 <<'END'
Oops!
Your 'rm' program seems unable to run without file operands specified
on the command line, even when the '-f' option is present. This is contrary
to the behaviour of most rm programs out there, and not conforming with
the upcoming POSIX standard:
Please tell bug-automake@gnu.org about your system, including the value
of your $PATH and any error possibly output before this message. This
can help us improve future automake versions.
END
if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then
echo 'Configuration will proceed anyway, since you have set the' >&2
echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2
echo >&2
else
cat >&2 <<'END'
Aborting the configuration process, to ensure you take notice of the issue.
You can download and install GNU coreutils to get an 'rm' implementation
that behaves properly: .
If you want to complete the configuration process using your problematic
'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM
to "yes", and re-run configure.
END
as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable maintainer-specific portions of Makefiles" >&5
$as_echo_n "checking whether to enable maintainer-specific portions of Makefiles... " >&6; }
# Check whether --enable-maintainer-mode was given.
if test "${enable_maintainer_mode+set}" = set; then :
enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval
else
USE_MAINTAINER_MODE=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_MAINTAINER_MODE" >&5
$as_echo "$USE_MAINTAINER_MODE" >&6; }
if test $USE_MAINTAINER_MODE = yes; then
MAINTAINER_MODE_TRUE=
MAINTAINER_MODE_FALSE='#'
else
MAINTAINER_MODE_TRUE='#'
MAINTAINER_MODE_FALSE=
fi
MAINT=$MAINTAINER_MODE_TRUE
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
if test -n "$ac_tool_prefix"; then
for ac_prog in g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 xlf90 f90 pgf90 pghpf epcf90 gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$F77"; then
ac_cv_prog_F77="$F77" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_F77="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
F77=$ac_cv_prog_F77
if test -n "$F77"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $F77" >&5
$as_echo "$F77" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$F77" && break
done
fi
if test -z "$F77"; then
ac_ct_F77=$F77
for ac_prog in g77 xlf f77 frt pgf77 cf77 fort77 fl32 af77 xlf90 f90 pgf90 pghpf epcf90 gfortran g95 xlf95 f95 fort ifort ifc efc pgfortran pgf95 lf95 ftn nagfor
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_F77"; then
ac_cv_prog_ac_ct_F77="$ac_ct_F77" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_F77="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_F77=$ac_cv_prog_ac_ct_F77
if test -n "$ac_ct_F77"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_F77" >&5
$as_echo "$ac_ct_F77" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$ac_ct_F77" && break
done
if test "x$ac_ct_F77" = x; then
F77=""
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
F77=$ac_ct_F77
fi
fi
# Provide some information about the compiler.
$as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 compiler version" >&5
set X $ac_compile
ac_compiler=$2
for ac_option in --version -v -V -qversion; do
{ { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
sed '10a\
... rest of stderr output deleted ...
10q' conftest.err >conftest.er1
cat conftest.er1 >&5
fi
rm -f conftest.er1 conftest.err
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
done
rm -f a.out
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the Fortran 77 compiler works" >&5
$as_echo_n "checking whether the Fortran 77 compiler works... " >&6; }
ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
# The possible output files:
ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
ac_rmfiles=
for ac_file in $ac_files
do
case $ac_file in
*.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
* ) ac_rmfiles="$ac_rmfiles $ac_file";;
esac
done
rm -f $ac_rmfiles
if { { ac_try="$ac_link_default"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link_default") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then :
# Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
# in a Makefile. We should not override ac_cv_exeext if it was cached,
# so that the user can short-circuit this test for compilers unknown to
# Autoconf.
for ac_file in $ac_files ''
do
test -f "$ac_file" || continue
case $ac_file in
*.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
;;
[ab].out )
# We found the default executable, but exeext='' is most
# certainly right.
break;;
*.* )
if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
then :; else
ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
fi
# We set ac_cv_exeext here because the later test for it is not
# safe: cross compilers may not add the suffix if given an `-o'
# argument, so we may need to know it at that point already.
# Even if this section looks crufty: it has the advantage of
# actually working.
break;;
* )
break;;
esac
done
test "$ac_cv_exeext" = no && ac_cv_exeext=
else
ac_file=''
fi
if test -z "$ac_file"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error 77 "Fortran 77 compiler cannot create executables
See \`config.log' for more details" "$LINENO" 5; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 compiler default output file name" >&5
$as_echo_n "checking for Fortran 77 compiler default output file name... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
$as_echo "$ac_file" >&6; }
ac_exeext=$ac_cv_exeext
rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "checking for suffix of executables... " >&6; }
if { { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then :
# If both `conftest.exe' and `conftest' are `present' (well, observable)
# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
# work properly (i.e., refer to `conftest.exe'), while it won't with
# `rm'.
for ac_file in conftest.exe conftest conftest.*; do
test -f "$ac_file" || continue
case $ac_file in
*.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
*.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
break;;
* ) break;;
esac
done
else
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of executables: cannot compile and link
See \`config.log' for more details" "$LINENO" 5; }
fi
rm -f conftest conftest$ac_cv_exeext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$ac_cv_exeext" >&6; }
rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
cat > conftest.$ac_ext <<_ACEOF
program main
open(unit=9,file='conftest.out')
close(unit=9)
end
_ACEOF
ac_clean_files="$ac_clean_files conftest.out"
# Check that the compiler produces executables we can run. If not, either
# the compiler is broken, or we cross compile.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "checking whether we are cross compiling... " >&6; }
if test "$cross_compiling" != yes; then
{ { ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_link") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
if { ac_try='./conftest$ac_cv_exeext'
{ { case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_try") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; }; then
cross_compiling=no
else
if test "$cross_compiling" = maybe; then
cross_compiling=yes
else
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot run Fortran 77 compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details" "$LINENO" 5; }
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }
rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
ac_clean_files=$ac_clean_files_save
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
$as_echo_n "checking for suffix of object files... " >&6; }
if ${ac_cv_objext+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
rm -f conftest.o conftest.obj
if { { ac_try="$ac_compile"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compile") 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then :
for ac_file in conftest.o conftest.obj conftest.*; do
test -f "$ac_file" || continue;
case $ac_file in
*.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
*) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
break;;
esac
done
else
$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of object files: cannot compile
See \`config.log' for more details" "$LINENO" 5; }
fi
rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
# If we don't use `.F' as extension, the preprocessor is not run on the
# input file. (Note that this only needs to work for GNU compilers.)
ac_save_ext=$ac_ext
ac_ext=F
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU Fortran 77 compiler" >&5
$as_echo_n "checking whether we are using the GNU Fortran 77 compiler... " >&6; }
if ${ac_cv_f77_compiler_gnu+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
program main
#ifndef __GNUC__
choke me
#endif
end
_ACEOF
if ac_fn_f77_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_f77_compiler_gnu=$ac_compiler_gnu
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_compiler_gnu" >&5
$as_echo "$ac_cv_f77_compiler_gnu" >&6; }
ac_ext=$ac_save_ext
ac_test_FFLAGS=${FFLAGS+set}
ac_save_FFLAGS=$FFLAGS
FFLAGS=
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $F77 accepts -g" >&5
$as_echo_n "checking whether $F77 accepts -g... " >&6; }
if ${ac_cv_prog_f77_g+:} false; then :
$as_echo_n "(cached) " >&6
else
FFLAGS=-g
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
if ac_fn_f77_try_compile "$LINENO"; then :
ac_cv_prog_f77_g=yes
else
ac_cv_prog_f77_g=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_g" >&5
$as_echo "$ac_cv_prog_f77_g" >&6; }
if test "$ac_test_FFLAGS" = set; then
FFLAGS=$ac_save_FFLAGS
elif test $ac_cv_prog_f77_g = yes; then
if test "x$ac_cv_f77_compiler_gnu" = xyes; then
FFLAGS="-g -O2"
else
FFLAGS="-g"
fi
else
if test "x$ac_cv_f77_compiler_gnu" = xyes; then
FFLAGS="-O2"
else
FFLAGS=
fi
fi
if test $ac_compiler_gnu = yes; then
G77=yes
else
G77=
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
case `pwd` in
*\ * | *\ *)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5
$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;;
esac
macro_version='2.4.2'
macro_revision='1.3337'
ltmain="$ac_aux_dir/ltmain.sh"
# Make sure we can run config.sub.
$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 ||
as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5
$as_echo_n "checking build system type... " >&6; }
if ${ac_cv_build+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_build_alias=$build_alias
test "x$ac_build_alias" = x &&
ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"`
test "x$ac_build_alias" = x &&
as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5
ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` ||
as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5
$as_echo "$ac_cv_build" >&6; }
case $ac_cv_build in
*-*-*) ;;
*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;;
esac
build=$ac_cv_build
ac_save_IFS=$IFS; IFS='-'
set x $ac_cv_build
shift
build_cpu=$1
build_vendor=$2
shift; shift
# Remember, the first character of IFS is used to create $*,
# except with old shells:
build_os=$*
IFS=$ac_save_IFS
case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5
$as_echo_n "checking host system type... " >&6; }
if ${ac_cv_host+:} false; then :
$as_echo_n "(cached) " >&6
else
if test "x$host_alias" = x; then
ac_cv_host=$ac_cv_build
else
ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` ||
as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5
$as_echo "$ac_cv_host" >&6; }
case $ac_cv_host in
*-*-*) ;;
*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;;
esac
host=$ac_cv_host
ac_save_IFS=$IFS; IFS='-'
set x $ac_cv_host
shift
host_cpu=$1
host_vendor=$2
shift; shift
# Remember, the first character of IFS is used to create $*,
# except with old shells:
host_os=$*
IFS=$ac_save_IFS
case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac
# Backslashify metacharacters that are still active within
# double-quoted strings.
sed_quote_subst='s/\(["`$\\]\)/\\\1/g'
# Same as above, but do not quote variable references.
double_quote_subst='s/\(["`\\]\)/\\\1/g'
# Sed substitution to delay expansion of an escaped shell variable in a
# double_quote_subst'ed string.
delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
# Sed substitution to delay expansion of an escaped single quote.
delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g'
# Sed substitution to avoid accidental globbing in evaled expressions
no_glob_subst='s/\*/\\\*/g'
ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO
ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5
$as_echo_n "checking how to print strings... " >&6; }
# Test print first, because it will be a builtin if present.
if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \
test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then
ECHO='print -r --'
elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then
ECHO='printf %s\n'
else
# Use this function as a fallback that always works.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
$1
_LTECHO_EOF'
}
ECHO='func_fallback_echo'
fi
# func_echo_all arg...
# Invoke $ECHO with all args, space-separated.
func_echo_all ()
{
$ECHO ""
}
case "$ECHO" in
printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5
$as_echo "printf" >&6; } ;;
print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5
$as_echo "print -r" >&6; } ;;
*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5
$as_echo "cat" >&6; } ;;
esac
DEPDIR="${am__leading_dot}deps"
ac_config_commands="$ac_config_commands depfiles"
am_make=${MAKE-make}
cat > confinc << 'END'
am__doit:
@echo this is the am__doit target
.PHONY: am__doit
END
# If we don't find an include directive, just comment out the code.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5
$as_echo_n "checking for style of include used by $am_make... " >&6; }
am__include="#"
am__quote=
_am_result=none
# First try GNU make style include.
echo "include confinc" > confmf
# Ignore all kinds of additional output from 'make'.
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=include
am__quote=
_am_result=GNU
;;
esac
# Now try BSD make style include.
if test "$am__include" = "#"; then
echo '.include "confinc"' > confmf
case `$am_make -s -f confmf 2> /dev/null` in #(
*the\ am__doit\ target*)
am__include=.include
am__quote="\""
_am_result=BSD
;;
esac
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5
$as_echo "$_am_result" >&6; }
rm -f confinc confmf
# Check whether --enable-dependency-tracking was given.
if test "${enable_dependency_tracking+set}" = set; then :
enableval=$enable_dependency_tracking;
fi
if test "x$enable_dependency_tracking" != xno; then
am_depcomp="$ac_aux_dir/depcomp"
AMDEPBACKSLASH='\'
am__nodep='_no'
fi
if test "x$enable_dependency_tracking" != xno; then
AMDEP_TRUE=
AMDEP_FALSE='#'
else
AMDEP_TRUE='#'
AMDEP_FALSE=
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_CC"; then
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_CC" = x; then
CC=""
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
fi
else
CC="$ac_cv_prog_CC"
fi
if test -z "$CC"; then
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
fi
if test -z "$CC"; then
# Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
ac_prog_rejected=no
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
set dummy $ac_cv_prog_CC
shift
if test $# != 0; then
# We chose a different compiler from the bogus one.
# However, it has the same basename, so the bogon will be chosen
# first if we set CC to just the basename; use the full file name.
shift
ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
fi
fi
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$CC"; then
if test -n "$ac_tool_prefix"; then
for ac_prog in cl.exe
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$CC" && break
done
fi
if test -z "$CC"; then
ac_ct_CC=$CC
for ac_prog in cl.exe
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$ac_ct_CC" && break
done
if test "x$ac_ct_CC" = x; then
CC=""
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
CC=$ac_ct_CC
fi
fi
fi
test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "no acceptable C compiler found in \$PATH
See \`config.log' for more details" "$LINENO" 5; }
# Provide some information about the compiler.
$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
set X $ac_compile
ac_compiler=$2
for ac_option in --version -v -V -qversion; do
{ { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
(eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
if test -s conftest.err; then
sed '10a\
... rest of stderr output deleted ...
10q' conftest.err >conftest.er1
cat conftest.er1 >&5
fi
rm -f conftest.er1 conftest.err
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
done
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
if ${ac_cv_c_compiler_gnu+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
#ifndef __GNUC__
choke me
#endif
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
$as_echo "$ac_cv_c_compiler_gnu" >&6; }
if test $ac_compiler_gnu = yes; then
GCC=yes
else
GCC=
fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
$as_echo_n "checking whether $CC accepts -g... " >&6; }
if ${ac_cv_prog_cc_g+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_save_c_werror_flag=$ac_c_werror_flag
ac_c_werror_flag=yes
ac_cv_prog_cc_g=no
CFLAGS="-g"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
else
CFLAGS=""
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
else
ac_c_werror_flag=$ac_save_c_werror_flag
CFLAGS="-g"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_c_werror_flag=$ac_save_c_werror_flag
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; then
CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
if test "$GCC" = yes; then
CFLAGS="-g -O2"
else
CFLAGS="-g"
fi
else
if test "$GCC" = yes; then
CFLAGS="-O2"
else
CFLAGS=
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
if ${ac_cv_prog_cc_c89+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_cv_prog_cc_c89=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
#include
struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
static char *e (p, i)
char **p;
int i;
{
return p[i];
}
static char *f (char * (*g) (char **, int), char **p, ...)
{
char *s;
va_list v;
va_start (v,p);
s = g (p, va_arg (v,int));
va_end (v);
return s;
}
/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
function prototypes and stuff, but not '\xHH' hex character constants.
These don't provoke an error unfortunately, instead are silently treated
as 'x'. The following induces an error, until -std is added to get
proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
array size at least. It's necessary to write '\x00'==0 to get something
that's true only with -std. */
int osf4_cc_array ['\x00' == 0 ? 1 : -1];
/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
inside strings and character constants. */
#define FOO(x) 'x'
int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
int test (int i, double x);
struct s1 {int (*f) (int a);};
struct s2 {int (*f) (double a);};
int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
int argc;
char **argv;
int
main ()
{
return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
;
return 0;
}
_ACEOF
for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_c89=$ac_arg
fi
rm -f core conftest.err conftest.$ac_objext
test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
# AC_CACHE_VAL
case "x$ac_cv_prog_cc_c89" in
x)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
$as_echo "none needed" >&6; } ;;
xno)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
$as_echo "unsupported" >&6; } ;;
*)
CC="$CC $ac_cv_prog_cc_c89"
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
if test "x$ac_cv_prog_cc_c89" != xno; then :
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5
$as_echo_n "checking whether $CC understands -c and -o together... " >&6; }
if ${am_cv_prog_cc_c_o+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
# Make sure it works both with $CC and with simple cc.
# Following AC_PROG_CC_C_O, we do the test twice because some
# compilers refuse to overwrite an existing .o file with -o,
# though they will create one.
am_cv_prog_cc_c_o=yes
for am_i in 1 2; do
if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5
($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } \
&& test -f conftest2.$ac_objext; then
: OK
else
am_cv_prog_cc_c_o=no
break
fi
done
rm -f core conftest*
unset am_i
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5
$as_echo "$am_cv_prog_cc_c_o" >&6; }
if test "$am_cv_prog_cc_c_o" != yes; then
# Losing compiler, so override with the script.
# FIXME: It is wrong to rewrite CC.
# But if we don't then we get into trouble of one sort or another.
# A longer-term fix would be to have automake use am__CC in this case,
# and then we could set am__CC="\$(top_srcdir)/compile \$(CC)"
CC="$am_aux_dir/compile $CC"
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
depcc="$CC" am_compiler_list=
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5
$as_echo_n "checking dependency style of $depcc... " >&6; }
if ${am_cv_CC_dependencies_compiler_type+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then
# We make a subdir and do the tests there. Otherwise we can end up
# making bogus files that we don't know about and never remove. For
# instance it was reported that on HP-UX the gcc test will end up
# making a dummy file named 'D' -- because '-MD' means "put the output
# in D".
rm -rf conftest.dir
mkdir conftest.dir
# Copy depcomp to subdir because otherwise we won't find it if we're
# using a relative directory.
cp "$am_depcomp" conftest.dir
cd conftest.dir
# We will build objects and dependencies in a subdirectory because
# it helps to detect inapplicable dependency modes. For instance
# both Tru64's cc and ICC support -MD to output dependencies as a
# side effect of compilation, but ICC will put the dependencies in
# the current directory while Tru64 will put them in the object
# directory.
mkdir sub
am_cv_CC_dependencies_compiler_type=none
if test "$am_compiler_list" = ""; then
am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp`
fi
am__universal=false
case " $depcc " in #(
*\ -arch\ *\ -arch\ *) am__universal=true ;;
esac
for depmode in $am_compiler_list; do
# Setup a source with many dependencies, because some compilers
# like to wrap large dependency lists on column 80 (with \), and
# we should not choose a depcomp mode which is confused by this.
#
# We need to recreate these files for each test, as the compiler may
# overwrite some of them when testing with obscure command lines.
# This happens at least with the AIX C compiler.
: > sub/conftest.c
for i in 1 2 3 4 5 6; do
echo '#include "conftst'$i'.h"' >> sub/conftest.c
# Using ": > sub/conftst$i.h" creates only sub/conftst1.h with
# Solaris 10 /bin/sh.
echo '/* dummy */' > sub/conftst$i.h
done
echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf
# We check with '-c' and '-o' for the sake of the "dashmstdout"
# mode. It turns out that the SunPro C++ compiler does not properly
# handle '-M -o', and we need to detect this. Also, some Intel
# versions had trouble with output in subdirs.
am__obj=sub/conftest.${OBJEXT-o}
am__minus_obj="-o $am__obj"
case $depmode in
gcc)
# This depmode causes a compiler race in universal mode.
test "$am__universal" = false || continue
;;
nosideeffect)
# After this tag, mechanisms are not by side-effect, so they'll
# only be used when explicitly requested.
if test "x$enable_dependency_tracking" = xyes; then
continue
else
break
fi
;;
msvc7 | msvc7msys | msvisualcpp | msvcmsys)
# This compiler won't grok '-c -o', but also, the minuso test has
# not run yet. These depmodes are late enough in the game, and
# so weak that their functioning should not be impacted.
am__obj=conftest.${OBJEXT-o}
am__minus_obj=
;;
none) break ;;
esac
if depmode=$depmode \
source=sub/conftest.c object=$am__obj \
depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \
$SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \
>/dev/null 2>conftest.err &&
grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 &&
grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 &&
grep $am__obj sub/conftest.Po > /dev/null 2>&1 &&
${MAKE-make} -s -f confmf > /dev/null 2>&1; then
# icc doesn't choke on unknown options, it will just issue warnings
# or remarks (even with -Werror). So we grep stderr for any message
# that says an option was ignored or not supported.
# When given -MP, icc 7.0 and 7.1 complain thusly:
# icc: Command line warning: ignoring option '-M'; no argument required
# The diagnosis changed in icc 8.0:
# icc: Command line remark: option '-MP' not supported
if (grep 'ignoring option' conftest.err ||
grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else
am_cv_CC_dependencies_compiler_type=$depmode
break
fi
fi
done
cd ..
rm -rf conftest.dir
else
am_cv_CC_dependencies_compiler_type=none
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5
$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; }
CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type
if
test "x$enable_dependency_tracking" != xno \
&& test "$am_cv_CC_dependencies_compiler_type" = gcc3; then
am__fastdepCC_TRUE=
am__fastdepCC_FALSE='#'
else
am__fastdepCC_TRUE='#'
am__fastdepCC_FALSE=
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5
$as_echo_n "checking for a sed that does not truncate output... " >&6; }
if ${ac_cv_path_SED+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/
for ac_i in 1 2 3 4 5 6 7; do
ac_script="$ac_script$as_nl$ac_script"
done
echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed
{ ac_script=; unset ac_script;}
if test -z "$SED"; then
ac_path_SED_found=false
# Loop through the user's path and test for each of PROGNAME-LIST
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_prog in sed gsed; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_SED="$as_dir/$ac_prog$ac_exec_ext"
as_fn_executable_p "$ac_path_SED" || continue
# Check for GNU ac_path_SED and select it if it is found.
# Check for GNU $ac_path_SED
case `"$ac_path_SED" --version 2>&1` in
*GNU*)
ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;;
*)
ac_count=0
$as_echo_n 0123456789 >"conftest.in"
while :
do
cat "conftest.in" "conftest.in" >"conftest.tmp"
mv "conftest.tmp" "conftest.in"
cp "conftest.in" "conftest.nl"
$as_echo '' >> "conftest.nl"
"$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break
diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
as_fn_arith $ac_count + 1 && ac_count=$as_val
if test $ac_count -gt ${ac_path_SED_max-0}; then
# Best one so far, save it but keep looking for a better one
ac_cv_path_SED="$ac_path_SED"
ac_path_SED_max=$ac_count
fi
# 10*(2^10) chars as input seems more than enough
test $ac_count -gt 10 && break
done
rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac
$ac_path_SED_found && break 3
done
done
done
IFS=$as_save_IFS
if test -z "$ac_cv_path_SED"; then
as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5
fi
else
ac_cv_path_SED=$SED
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5
$as_echo "$ac_cv_path_SED" >&6; }
SED="$ac_cv_path_SED"
rm -f conftest.sed
test -z "$SED" && SED=sed
Xsed="$SED -e 1s/^X//"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
if ${ac_cv_path_GREP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -z "$GREP"; then
ac_path_GREP_found=false
# Loop through the user's path and test for each of PROGNAME-LIST
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_prog in grep ggrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
as_fn_executable_p "$ac_path_GREP" || continue
# Check for GNU ac_path_GREP and select it if it is found.
# Check for GNU $ac_path_GREP
case `"$ac_path_GREP" --version 2>&1` in
*GNU*)
ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
*)
ac_count=0
$as_echo_n 0123456789 >"conftest.in"
while :
do
cat "conftest.in" "conftest.in" >"conftest.tmp"
mv "conftest.tmp" "conftest.in"
cp "conftest.in" "conftest.nl"
$as_echo 'GREP' >> "conftest.nl"
"$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
as_fn_arith $ac_count + 1 && ac_count=$as_val
if test $ac_count -gt ${ac_path_GREP_max-0}; then
# Best one so far, save it but keep looking for a better one
ac_cv_path_GREP="$ac_path_GREP"
ac_path_GREP_max=$ac_count
fi
# 10*(2^10) chars as input seems more than enough
test $ac_count -gt 10 && break
done
rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac
$ac_path_GREP_found && break 3
done
done
done
IFS=$as_save_IFS
if test -z "$ac_cv_path_GREP"; then
as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
fi
else
ac_cv_path_GREP=$GREP
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
$as_echo "$ac_cv_path_GREP" >&6; }
GREP="$ac_cv_path_GREP"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
$as_echo_n "checking for egrep... " >&6; }
if ${ac_cv_path_EGREP+:} false; then :
$as_echo_n "(cached) " >&6
else
if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
then ac_cv_path_EGREP="$GREP -E"
else
if test -z "$EGREP"; then
ac_path_EGREP_found=false
# Loop through the user's path and test for each of PROGNAME-LIST
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_prog in egrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
as_fn_executable_p "$ac_path_EGREP" || continue
# Check for GNU ac_path_EGREP and select it if it is found.
# Check for GNU $ac_path_EGREP
case `"$ac_path_EGREP" --version 2>&1` in
*GNU*)
ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
*)
ac_count=0
$as_echo_n 0123456789 >"conftest.in"
while :
do
cat "conftest.in" "conftest.in" >"conftest.tmp"
mv "conftest.tmp" "conftest.in"
cp "conftest.in" "conftest.nl"
$as_echo 'EGREP' >> "conftest.nl"
"$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
as_fn_arith $ac_count + 1 && ac_count=$as_val
if test $ac_count -gt ${ac_path_EGREP_max-0}; then
# Best one so far, save it but keep looking for a better one
ac_cv_path_EGREP="$ac_path_EGREP"
ac_path_EGREP_max=$ac_count
fi
# 10*(2^10) chars as input seems more than enough
test $ac_count -gt 10 && break
done
rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac
$ac_path_EGREP_found && break 3
done
done
done
IFS=$as_save_IFS
if test -z "$ac_cv_path_EGREP"; then
as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
fi
else
ac_cv_path_EGREP=$EGREP
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
$as_echo "$ac_cv_path_EGREP" >&6; }
EGREP="$ac_cv_path_EGREP"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5
$as_echo_n "checking for fgrep... " >&6; }
if ${ac_cv_path_FGREP+:} false; then :
$as_echo_n "(cached) " >&6
else
if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1
then ac_cv_path_FGREP="$GREP -F"
else
if test -z "$FGREP"; then
ac_path_FGREP_found=false
# Loop through the user's path and test for each of PROGNAME-LIST
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_prog in fgrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext"
as_fn_executable_p "$ac_path_FGREP" || continue
# Check for GNU ac_path_FGREP and select it if it is found.
# Check for GNU $ac_path_FGREP
case `"$ac_path_FGREP" --version 2>&1` in
*GNU*)
ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;;
*)
ac_count=0
$as_echo_n 0123456789 >"conftest.in"
while :
do
cat "conftest.in" "conftest.in" >"conftest.tmp"
mv "conftest.tmp" "conftest.in"
cp "conftest.in" "conftest.nl"
$as_echo 'FGREP' >> "conftest.nl"
"$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break
diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
as_fn_arith $ac_count + 1 && ac_count=$as_val
if test $ac_count -gt ${ac_path_FGREP_max-0}; then
# Best one so far, save it but keep looking for a better one
ac_cv_path_FGREP="$ac_path_FGREP"
ac_path_FGREP_max=$ac_count
fi
# 10*(2^10) chars as input seems more than enough
test $ac_count -gt 10 && break
done
rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac
$ac_path_FGREP_found && break 3
done
done
done
IFS=$as_save_IFS
if test -z "$ac_cv_path_FGREP"; then
as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
fi
else
ac_cv_path_FGREP=$FGREP
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5
$as_echo "$ac_cv_path_FGREP" >&6; }
FGREP="$ac_cv_path_FGREP"
test -z "$GREP" && GREP=grep
# Check whether --with-gnu-ld was given.
if test "${with_gnu_ld+set}" = set; then :
withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes
else
with_gnu_ld=no
fi
ac_prog=ld
if test "$GCC" = yes; then
# Check if gcc -print-prog-name=ld gives a path.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5
$as_echo_n "checking for ld used by $CC... " >&6; }
case $host in
*-*-mingw*)
# gcc leaves a trailing carriage return which upsets mingw
ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
*)
ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
esac
case $ac_prog in
# Accept absolute paths.
[\\/]* | ?:[\\/]*)
re_direlt='/[^/][^/]*/\.\./'
# Canonicalize the pathname of ld
ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'`
while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do
ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"`
done
test -z "$LD" && LD="$ac_prog"
;;
"")
# If it fails, then pretend we aren't using GCC.
ac_prog=ld
;;
*)
# If it is relative, then search for the first ld in PATH.
with_gnu_ld=unknown
;;
esac
elif test "$with_gnu_ld" = yes; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5
$as_echo_n "checking for GNU ld... " >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5
$as_echo_n "checking for non-GNU ld... " >&6; }
fi
if ${lt_cv_path_LD+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -z "$LD"; then
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
for ac_dir in $PATH; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
lt_cv_path_LD="$ac_dir/$ac_prog"
# Check to see if the program is GNU ld. I'd rather use --version,
# but apparently some variants of GNU ld only accept -v.
# Break only if it was the GNU/non-GNU ld that we prefer.
case `"$lt_cv_path_LD" -v 2>&1 &5
$as_echo "$LD" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5
$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; }
if ${lt_cv_prog_gnu_ld+:} false; then :
$as_echo_n "(cached) " >&6
else
# I'd rather use --version here, but apparently some GNU lds only accept -v.
case `$LD -v 2>&1 &5
$as_echo "$lt_cv_prog_gnu_ld" >&6; }
with_gnu_ld=$lt_cv_prog_gnu_ld
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5
$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; }
if ${lt_cv_path_NM+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$NM"; then
# Let the user override the test.
lt_cv_path_NM="$NM"
else
lt_nm_to_check="${ac_tool_prefix}nm"
if test -n "$ac_tool_prefix" && test "$build" = "$host"; then
lt_nm_to_check="$lt_nm_to_check nm"
fi
for lt_tmp_nm in $lt_nm_to_check; do
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
tmp_nm="$ac_dir/$lt_tmp_nm"
if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext" ; then
# Check to see if the nm accepts a BSD-compat flag.
# Adding the `sed 1q' prevents false positives on HP-UX, which says:
# nm: unknown option "B" ignored
# Tru64's nm complains that /dev/null is an invalid object file
case `"$tmp_nm" -B /dev/null 2>&1 | sed '1q'` in
*/dev/null* | *'Invalid file or object type'*)
lt_cv_path_NM="$tmp_nm -B"
break
;;
*)
case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in
*/dev/null*)
lt_cv_path_NM="$tmp_nm -p"
break
;;
*)
lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but
continue # so that we can try to find one that supports BSD flags
;;
esac
;;
esac
fi
done
IFS="$lt_save_ifs"
done
: ${lt_cv_path_NM=no}
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5
$as_echo "$lt_cv_path_NM" >&6; }
if test "$lt_cv_path_NM" != "no"; then
NM="$lt_cv_path_NM"
else
# Didn't find any BSD compatible name lister, look for dumpbin.
if test -n "$DUMPBIN"; then :
# Let the user override the test.
else
if test -n "$ac_tool_prefix"; then
for ac_prog in dumpbin "link -dump"
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_DUMPBIN+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$DUMPBIN"; then
ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
DUMPBIN=$ac_cv_prog_DUMPBIN
if test -n "$DUMPBIN"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5
$as_echo "$DUMPBIN" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$DUMPBIN" && break
done
fi
if test -z "$DUMPBIN"; then
ac_ct_DUMPBIN=$DUMPBIN
for ac_prog in dumpbin "link -dump"
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_DUMPBIN"; then
ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_DUMPBIN="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN
if test -n "$ac_ct_DUMPBIN"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5
$as_echo "$ac_ct_DUMPBIN" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$ac_ct_DUMPBIN" && break
done
if test "x$ac_ct_DUMPBIN" = x; then
DUMPBIN=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
DUMPBIN=$ac_ct_DUMPBIN
fi
fi
case `$DUMPBIN -symbols /dev/null 2>&1 | sed '1q'` in
*COFF*)
DUMPBIN="$DUMPBIN -symbols"
;;
*)
DUMPBIN=:
;;
esac
fi
if test "$DUMPBIN" != ":"; then
NM="$DUMPBIN"
fi
fi
test -z "$NM" && NM=nm
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5
$as_echo_n "checking the name lister ($NM) interface... " >&6; }
if ${lt_cv_nm_interface+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_nm_interface="BSD nm"
echo "int some_variable = 0;" > conftest.$ac_ext
(eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5)
(eval "$ac_compile" 2>conftest.err)
cat conftest.err >&5
(eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
(eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
cat conftest.err >&5
(eval echo "\"\$as_me:$LINENO: output\"" >&5)
cat conftest.out >&5
if $GREP 'External.*some_variable' conftest.out > /dev/null; then
lt_cv_nm_interface="MS dumpbin"
fi
rm -f conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5
$as_echo "$lt_cv_nm_interface" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5
$as_echo_n "checking whether ln -s works... " >&6; }
LN_S=$as_ln_s
if test "$LN_S" = "ln -s"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5
$as_echo "no, using $LN_S" >&6; }
fi
# find the maximum length of command line arguments
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5
$as_echo_n "checking the maximum length of command line arguments... " >&6; }
if ${lt_cv_sys_max_cmd_len+:} false; then :
$as_echo_n "(cached) " >&6
else
i=0
teststring="ABCD"
case $build_os in
msdosdjgpp*)
# On DJGPP, this test can blow up pretty badly due to problems in libc
# (any single argument exceeding 2000 bytes causes a buffer overrun
# during glob expansion). Even if it were fixed, the result of this
# check would be larger than it should be.
lt_cv_sys_max_cmd_len=12288; # 12K is about right
;;
gnu*)
# Under GNU Hurd, this test is not required because there is
# no limit to the length of command line arguments.
# Libtool will interpret -1 as no limit whatsoever
lt_cv_sys_max_cmd_len=-1;
;;
cygwin* | mingw* | cegcc*)
# On Win9x/ME, this test blows up -- it succeeds, but takes
# about 5 minutes as the teststring grows exponentially.
# Worse, since 9x/ME are not pre-emptively multitasking,
# you end up with a "frozen" computer, even though with patience
# the test eventually succeeds (with a max line length of 256k).
# Instead, let's just punt: use the minimum linelength reported by
# all of the supported platforms: 8192 (on NT/2K/XP).
lt_cv_sys_max_cmd_len=8192;
;;
mint*)
# On MiNT this can take a long time and run out of memory.
lt_cv_sys_max_cmd_len=8192;
;;
amigaos*)
# On AmigaOS with pdksh, this test takes hours, literally.
# So we just punt and use a minimum line length of 8192.
lt_cv_sys_max_cmd_len=8192;
;;
netbsd* | freebsd* | openbsd* | darwin* | dragonfly*)
# This has been around since 386BSD, at least. Likely further.
if test -x /sbin/sysctl; then
lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax`
elif test -x /usr/sbin/sysctl; then
lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax`
else
lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs
fi
# And add a safety zone
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
;;
interix*)
# We know the value 262144 and hardcode it with a safety zone (like BSD)
lt_cv_sys_max_cmd_len=196608
;;
os2*)
# The test takes a long time on OS/2.
lt_cv_sys_max_cmd_len=8192
;;
osf*)
# Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure
# due to this test when exec_disable_arg_limit is 1 on Tru64. It is not
# nice to cause kernel panics so lets avoid the loop below.
# First set a reasonable default.
lt_cv_sys_max_cmd_len=16384
#
if test -x /sbin/sysconfig; then
case `/sbin/sysconfig -q proc exec_disable_arg_limit` in
*1*) lt_cv_sys_max_cmd_len=-1 ;;
esac
fi
;;
sco3.2v5*)
lt_cv_sys_max_cmd_len=102400
;;
sysv5* | sco5v6* | sysv4.2uw2*)
kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null`
if test -n "$kargmax"; then
lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'`
else
lt_cv_sys_max_cmd_len=32768
fi
;;
*)
lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null`
if test -n "$lt_cv_sys_max_cmd_len"; then
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4`
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3`
else
# Make teststring a little bigger before we do anything with it.
# a 1K string should be a reasonable start.
for i in 1 2 3 4 5 6 7 8 ; do
teststring=$teststring$teststring
done
SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}}
# If test is not a shell built-in, we'll probably end up computing a
# maximum length that is only half of the actual maximum length, but
# we can't tell.
while { test "X"`env echo "$teststring$teststring" 2>/dev/null` \
= "X$teststring$teststring"; } >/dev/null 2>&1 &&
test $i != 17 # 1/2 MB should be enough
do
i=`expr $i + 1`
teststring=$teststring$teststring
done
# Only check the string length outside the loop.
lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1`
teststring=
# Add a significant safety factor because C++ compilers can tack on
# massive amounts of additional arguments before passing them to the
# linker. It appears as though 1/2 is a usable value.
lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2`
fi
;;
esac
fi
if test -n $lt_cv_sys_max_cmd_len ; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5
$as_echo "$lt_cv_sys_max_cmd_len" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; }
fi
max_cmd_len=$lt_cv_sys_max_cmd_len
: ${CP="cp -f"}
: ${MV="mv -f"}
: ${RM="rm -f"}
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands some XSI constructs" >&5
$as_echo_n "checking whether the shell understands some XSI constructs... " >&6; }
# Try some XSI features
xsi_shell=no
( _lt_dummy="a/b/c"
test "${_lt_dummy##*/},${_lt_dummy%/*},${_lt_dummy#??}"${_lt_dummy%"$_lt_dummy"}, \
= c,a/b,b/c, \
&& eval 'test $(( 1 + 1 )) -eq 2 \
&& test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \
&& xsi_shell=yes
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $xsi_shell" >&5
$as_echo "$xsi_shell" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands \"+=\"" >&5
$as_echo_n "checking whether the shell understands \"+=\"... " >&6; }
lt_shell_append=no
( foo=bar; set foo baz; eval "$1+=\$2" && test "$foo" = barbaz ) \
>/dev/null 2>&1 \
&& lt_shell_append=yes
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_shell_append" >&5
$as_echo "$lt_shell_append" >&6; }
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
lt_unset=unset
else
lt_unset=false
fi
# test EBCDIC or ASCII
case `echo X|tr X '\101'` in
A) # ASCII based system
# \n is not interpreted correctly by Solaris 8 /usr/ucb/tr
lt_SP2NL='tr \040 \012'
lt_NL2SP='tr \015\012 \040\040'
;;
*) # EBCDIC based system
lt_SP2NL='tr \100 \n'
lt_NL2SP='tr \r\n \100\100'
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to $host format" >&5
$as_echo_n "checking how to convert $build file names to $host format... " >&6; }
if ${lt_cv_to_host_file_cmd+:} false; then :
$as_echo_n "(cached) " >&6
else
case $host in
*-*-mingw* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32
;;
*-*-cygwin* )
lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32
;;
* ) # otherwise, assume *nix
lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32
;;
esac
;;
*-*-cygwin* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin
;;
*-*-cygwin* )
lt_cv_to_host_file_cmd=func_convert_file_noop
;;
* ) # otherwise, assume *nix
lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin
;;
esac
;;
* ) # unhandled hosts (and "normal" native builds)
lt_cv_to_host_file_cmd=func_convert_file_noop
;;
esac
fi
to_host_file_cmd=$lt_cv_to_host_file_cmd
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_host_file_cmd" >&5
$as_echo "$lt_cv_to_host_file_cmd" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to toolchain format" >&5
$as_echo_n "checking how to convert $build file names to toolchain format... " >&6; }
if ${lt_cv_to_tool_file_cmd+:} false; then :
$as_echo_n "(cached) " >&6
else
#assume ordinary cross tools, or native build.
lt_cv_to_tool_file_cmd=func_convert_file_noop
case $host in
*-*-mingw* )
case $build in
*-*-mingw* ) # actually msys
lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32
;;
esac
;;
esac
fi
to_tool_file_cmd=$lt_cv_to_tool_file_cmd
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_tool_file_cmd" >&5
$as_echo "$lt_cv_to_tool_file_cmd" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5
$as_echo_n "checking for $LD option to reload object files... " >&6; }
if ${lt_cv_ld_reload_flag+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_ld_reload_flag='-r'
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5
$as_echo "$lt_cv_ld_reload_flag" >&6; }
reload_flag=$lt_cv_ld_reload_flag
case $reload_flag in
"" | " "*) ;;
*) reload_flag=" $reload_flag" ;;
esac
reload_cmds='$LD$reload_flag -o $output$reload_objs'
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
if test "$GCC" != yes; then
reload_cmds=false
fi
;;
darwin*)
if test "$GCC" = yes; then
reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs'
else
reload_cmds='$LD$reload_flag -o $output$reload_objs'
fi
;;
esac
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args.
set dummy ${ac_tool_prefix}objdump; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_OBJDUMP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$OBJDUMP"; then
ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
OBJDUMP=$ac_cv_prog_OBJDUMP
if test -n "$OBJDUMP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5
$as_echo "$OBJDUMP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_OBJDUMP"; then
ac_ct_OBJDUMP=$OBJDUMP
# Extract the first word of "objdump", so it can be a program name with args.
set dummy objdump; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_OBJDUMP"; then
ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_OBJDUMP="objdump"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP
if test -n "$ac_ct_OBJDUMP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5
$as_echo "$ac_ct_OBJDUMP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_OBJDUMP" = x; then
OBJDUMP="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
OBJDUMP=$ac_ct_OBJDUMP
fi
else
OBJDUMP="$ac_cv_prog_OBJDUMP"
fi
test -z "$OBJDUMP" && OBJDUMP=objdump
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5
$as_echo_n "checking how to recognize dependent libraries... " >&6; }
if ${lt_cv_deplibs_check_method+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_file_magic_cmd='$MAGIC_CMD'
lt_cv_file_magic_test_file=
lt_cv_deplibs_check_method='unknown'
# Need to set the preceding variable on all platforms that support
# interlibrary dependencies.
# 'none' -- dependencies not supported.
# `unknown' -- same as none, but documents that we really don't know.
# 'pass_all' -- all dependencies passed with no checks.
# 'test_compile' -- check by making test program.
# 'file_magic [[regex]]' -- check by looking for files in library path
# which responds to the $file_magic_cmd with a given extended regex.
# If you have `file' or equivalent on your system and you're not sure
# whether `pass_all' will *always* work, you probably want this one.
case $host_os in
aix[4-9]*)
lt_cv_deplibs_check_method=pass_all
;;
beos*)
lt_cv_deplibs_check_method=pass_all
;;
bsdi[45]*)
lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
lt_cv_file_magic_cmd='/usr/bin/file -L'
lt_cv_file_magic_test_file=/shlib/libc.so
;;
cygwin*)
# func_win32_libid is a shell function defined in ltmain.sh
lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
lt_cv_file_magic_cmd='func_win32_libid'
;;
mingw* | pw32*)
# Base MSYS/MinGW do not provide the 'file' command needed by
# func_win32_libid shell function, so use a weaker test based on 'objdump',
# unless we find 'file', for example because we are cross-compiling.
# func_win32_libid assumes BSD nm, so disallow it if using MS dumpbin.
if ( test "$lt_cv_nm_interface" = "BSD nm" && file / ) >/dev/null 2>&1; then
lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL'
lt_cv_file_magic_cmd='func_win32_libid'
else
# Keep this pattern in sync with the one in func_win32_libid.
lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)'
lt_cv_file_magic_cmd='$OBJDUMP -f'
fi
;;
cegcc*)
# use the weaker test based on 'objdump'. See mingw*.
lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?'
lt_cv_file_magic_cmd='$OBJDUMP -f'
;;
darwin* | rhapsody*)
lt_cv_deplibs_check_method=pass_all
;;
freebsd* | dragonfly*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
case $host_cpu in
i*86 )
# Not sure whether the presence of OpenBSD here was a mistake.
# Let's accept both of them until this is cleared up.
lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library'
lt_cv_file_magic_cmd=/usr/bin/file
lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*`
;;
esac
else
lt_cv_deplibs_check_method=pass_all
fi
;;
gnu*)
lt_cv_deplibs_check_method=pass_all
;;
haiku*)
lt_cv_deplibs_check_method=pass_all
;;
hpux10.20* | hpux11*)
lt_cv_file_magic_cmd=/usr/bin/file
case $host_cpu in
ia64*)
lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64'
lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so
;;
hppa*64*)
lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]'
lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl
;;
*)
lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library'
lt_cv_file_magic_test_file=/usr/lib/libc.sl
;;
esac
;;
interix[3-9]*)
# PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here
lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$'
;;
irix5* | irix6* | nonstopux*)
case $LD in
*-32|*"-32 ") libmagic=32-bit;;
*-n32|*"-n32 ") libmagic=N32;;
*-64|*"-64 ") libmagic=64-bit;;
*) libmagic=never-match;;
esac
lt_cv_deplibs_check_method=pass_all
;;
# This must be glibc/ELF.
linux* | k*bsd*-gnu | kopensolaris*-gnu)
lt_cv_deplibs_check_method=pass_all
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then
lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
else
lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$'
fi
;;
newos6*)
lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)'
lt_cv_file_magic_cmd=/usr/bin/file
lt_cv_file_magic_test_file=/usr/lib/libnls.so
;;
*nto* | *qnx*)
lt_cv_deplibs_check_method=pass_all
;;
openbsd*)
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$'
else
lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$'
fi
;;
osf3* | osf4* | osf5*)
lt_cv_deplibs_check_method=pass_all
;;
rdos*)
lt_cv_deplibs_check_method=pass_all
;;
solaris*)
lt_cv_deplibs_check_method=pass_all
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
lt_cv_deplibs_check_method=pass_all
;;
sysv4 | sysv4.3*)
case $host_vendor in
motorola)
lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
;;
ncr)
lt_cv_deplibs_check_method=pass_all
;;
sequent)
lt_cv_file_magic_cmd='/bin/file'
lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )'
;;
sni)
lt_cv_file_magic_cmd='/bin/file'
lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib"
lt_cv_file_magic_test_file=/lib/libc.so
;;
siemens)
lt_cv_deplibs_check_method=pass_all
;;
pc)
lt_cv_deplibs_check_method=pass_all
;;
esac
;;
tpf*)
lt_cv_deplibs_check_method=pass_all
;;
esac
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5
$as_echo "$lt_cv_deplibs_check_method" >&6; }
file_magic_glob=
want_nocaseglob=no
if test "$build" = "$host"; then
case $host_os in
mingw* | pw32*)
if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then
want_nocaseglob=yes
else
file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[\1]\/[\1]\/g;/g"`
fi
;;
esac
fi
file_magic_cmd=$lt_cv_file_magic_cmd
deplibs_check_method=$lt_cv_deplibs_check_method
test -z "$deplibs_check_method" && deplibs_check_method=unknown
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
set dummy ${ac_tool_prefix}dlltool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_DLLTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$DLLTOOL"; then
ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
DLLTOOL=$ac_cv_prog_DLLTOOL
if test -n "$DLLTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5
$as_echo "$DLLTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_DLLTOOL"; then
ac_ct_DLLTOOL=$DLLTOOL
# Extract the first word of "dlltool", so it can be a program name with args.
set dummy dlltool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_DLLTOOL"; then
ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_DLLTOOL="dlltool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL
if test -n "$ac_ct_DLLTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5
$as_echo "$ac_ct_DLLTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_DLLTOOL" = x; then
DLLTOOL="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
DLLTOOL=$ac_ct_DLLTOOL
fi
else
DLLTOOL="$ac_cv_prog_DLLTOOL"
fi
test -z "$DLLTOOL" && DLLTOOL=dlltool
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to associate runtime and link libraries" >&5
$as_echo_n "checking how to associate runtime and link libraries... " >&6; }
if ${lt_cv_sharedlib_from_linklib_cmd+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_sharedlib_from_linklib_cmd='unknown'
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
# two different shell functions defined in ltmain.sh
# decide which to use based on capabilities of $DLLTOOL
case `$DLLTOOL --help 2>&1` in
*--identify-strict*)
lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib
;;
*)
lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback
;;
esac
;;
*)
# fallback: assume linklib IS sharedlib
lt_cv_sharedlib_from_linklib_cmd="$ECHO"
;;
esac
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sharedlib_from_linklib_cmd" >&5
$as_echo "$lt_cv_sharedlib_from_linklib_cmd" >&6; }
sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd
test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO
if test -n "$ac_tool_prefix"; then
for ac_prog in ar
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AR+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$AR"; then
ac_cv_prog_AR="$AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AR="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
AR=$ac_cv_prog_AR
if test -n "$AR"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$AR" && break
done
fi
if test -z "$AR"; then
ac_ct_AR=$AR
for ac_prog in ar
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_AR+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_AR"; then
ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_AR="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_AR=$ac_cv_prog_ac_ct_AR
if test -n "$ac_ct_AR"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$ac_ct_AR" && break
done
if test "x$ac_ct_AR" = x; then
AR="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
AR=$ac_ct_AR
fi
fi
: ${AR=ar}
: ${AR_FLAGS=cru}
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for archiver @FILE support" >&5
$as_echo_n "checking for archiver @FILE support... " >&6; }
if ${lt_cv_ar_at_file+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_ar_at_file=no
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
echo conftest.$ac_objext > conftest.lst
lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&5'
{ { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5
(eval $lt_ar_try) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
if test "$ac_status" -eq 0; then
# Ensure the archiver fails upon bogus file names.
rm -f conftest.$ac_objext libconftest.a
{ { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5
(eval $lt_ar_try) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
if test "$ac_status" -ne 0; then
lt_cv_ar_at_file=@
fi
fi
rm -f conftest.* libconftest.a
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ar_at_file" >&5
$as_echo "$lt_cv_ar_at_file" >&6; }
if test "x$lt_cv_ar_at_file" = xno; then
archiver_list_spec=
else
archiver_list_spec=$lt_cv_ar_at_file
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
set dummy ${ac_tool_prefix}strip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_STRIP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$STRIP"; then
ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_STRIP="${ac_tool_prefix}strip"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
STRIP=$ac_cv_prog_STRIP
if test -n "$STRIP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5
$as_echo "$STRIP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_STRIP"; then
ac_ct_STRIP=$STRIP
# Extract the first word of "strip", so it can be a program name with args.
set dummy strip; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_STRIP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_STRIP"; then
ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_STRIP="strip"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP
if test -n "$ac_ct_STRIP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5
$as_echo "$ac_ct_STRIP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_STRIP" = x; then
STRIP=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
STRIP=$ac_ct_STRIP
fi
else
STRIP="$ac_cv_prog_STRIP"
fi
test -z "$STRIP" && STRIP=:
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RANLIB+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$RANLIB"; then
ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
RANLIB=$ac_cv_prog_RANLIB
if test -n "$RANLIB"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_RANLIB"; then
ac_ct_RANLIB=$RANLIB
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_RANLIB"; then
ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RANLIB="ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
if test -n "$ac_ct_RANLIB"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_RANLIB" = x; then
RANLIB=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
RANLIB=$ac_ct_RANLIB
fi
else
RANLIB="$ac_cv_prog_RANLIB"
fi
test -z "$RANLIB" && RANLIB=:
# Determine commands to create old-style static archives.
old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs'
old_postinstall_cmds='chmod 644 $oldlib'
old_postuninstall_cmds=
if test -n "$RANLIB"; then
case $host_os in
openbsd*)
old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib"
;;
*)
old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib"
;;
esac
old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib"
fi
case $host_os in
darwin*)
lock_old_archive_extraction=yes ;;
*)
lock_old_archive_extraction=no ;;
esac
# If no C compiler was specified, use CC.
LTCC=${LTCC-"$CC"}
# If no C compiler flags were specified, use CFLAGS.
LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
# Allow CC to be a program name with arguments.
compiler=$CC
# Check for command to grab the raw symbol name followed by C symbol from nm.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5
$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; }
if ${lt_cv_sys_global_symbol_pipe+:} false; then :
$as_echo_n "(cached) " >&6
else
# These are sane defaults that work on at least a few old systems.
# [They come from Ultrix. What could be older than Ultrix?!! ;)]
# Character class describing NM global symbol codes.
symcode='[BCDEGRST]'
# Regexp to match symbols that can be accessed directly from C.
sympat='\([_A-Za-z][_A-Za-z0-9]*\)'
# Define system-specific variables.
case $host_os in
aix*)
symcode='[BCDT]'
;;
cygwin* | mingw* | pw32* | cegcc*)
symcode='[ABCDGISTW]'
;;
hpux*)
if test "$host_cpu" = ia64; then
symcode='[ABCDEGRST]'
fi
;;
irix* | nonstopux*)
symcode='[BCDEGRST]'
;;
osf*)
symcode='[BCDEGQRST]'
;;
solaris*)
symcode='[BDRT]'
;;
sco3.2v5*)
symcode='[DT]'
;;
sysv4.2uw2*)
symcode='[DT]'
;;
sysv5* | sco5v6* | unixware* | OpenUNIX*)
symcode='[ABDT]'
;;
sysv4)
symcode='[DFNSTU]'
;;
esac
# If we're using GNU nm, then use its standard symbol codes.
case `$NM -V 2>&1` in
*GNU* | *'with BFD'*)
symcode='[ABCDGIRSTW]' ;;
esac
# Transform an extracted symbol line into a proper C declaration.
# Some systems (esp. on ia64) link data and code symbols differently,
# so use this general approach.
lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'"
# Transform an extracted symbol line into symbol name and symbol address
lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\)[ ]*$/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (void *) \&\2},/p'"
lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([^ ]*\)[ ]*$/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \(lib[^ ]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"lib\2\", (void *) \&\2},/p'"
# Handle CRLF in mingw tool chain
opt_cr=
case $build_os in
mingw*)
opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp
;;
esac
# Try without a prefix underscore, then with it.
for ac_symprfx in "" "_"; do
# Transform symcode, sympat, and symprfx into a raw symbol and a C symbol.
symxfrm="\\1 $ac_symprfx\\2 \\2"
# Write the raw and C identifiers.
if test "$lt_cv_nm_interface" = "MS dumpbin"; then
# Fake it for dumpbin and say T for any non-static function
# and D for any global variable.
# Also find C++ and __fastcall symbols from MSVC++,
# which start with @ or ?.
lt_cv_sys_global_symbol_pipe="$AWK '"\
" {last_section=section; section=\$ 3};"\
" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\
" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\
" \$ 0!~/External *\|/{next};"\
" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\
" {if(hide[section]) next};"\
" {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\
" {split(\$ 0, a, /\||\r/); split(a[2], s)};"\
" s[1]~/^[@?]/{print s[1], s[1]; next};"\
" s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\
" ' prfx=^$ac_symprfx"
else
lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'"
fi
lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'"
# Check to see that the pipe works correctly.
pipe_works=no
rm -f conftest*
cat > conftest.$ac_ext <<_LT_EOF
#ifdef __cplusplus
extern "C" {
#endif
char nm_test_var;
void nm_test_func(void);
void nm_test_func(void){}
#ifdef __cplusplus
}
#endif
int main(){nm_test_var='a';nm_test_func();return(0);}
_LT_EOF
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then
# Now try to grab the symbols.
nlist=conftest.nm
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5
(eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && test -s "$nlist"; then
# Try sorting and uniquifying the output.
if sort "$nlist" | uniq > "$nlist"T; then
mv -f "$nlist"T "$nlist"
else
rm -f "$nlist"T
fi
# Make sure that we snagged all the symbols we need.
if $GREP ' nm_test_var$' "$nlist" >/dev/null; then
if $GREP ' nm_test_func$' "$nlist" >/dev/null; then
cat <<_LT_EOF > conftest.$ac_ext
/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */
#if defined(_WIN32) || defined(__CYGWIN__) || defined(_WIN32_WCE)
/* DATA imports from DLLs on WIN32 con't be const, because runtime
relocations are performed -- see ld's documentation on pseudo-relocs. */
# define LT_DLSYM_CONST
#elif defined(__osf__)
/* This system does not cope well with relocations in const data. */
# define LT_DLSYM_CONST
#else
# define LT_DLSYM_CONST const
#endif
#ifdef __cplusplus
extern "C" {
#endif
_LT_EOF
# Now generate the symbol file.
eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext'
cat <<_LT_EOF >> conftest.$ac_ext
/* The mapping between symbol names and symbols. */
LT_DLSYM_CONST struct {
const char *name;
void *address;
}
lt__PROGRAM__LTX_preloaded_symbols[] =
{
{ "@PROGRAM@", (void *) 0 },
_LT_EOF
$SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext
cat <<\_LT_EOF >> conftest.$ac_ext
{0, (void *) 0}
};
/* This works around a problem in FreeBSD linker */
#ifdef FREEBSD_WORKAROUND
static const void *lt_preloaded_setup() {
return lt__PROGRAM__LTX_preloaded_symbols;
}
#endif
#ifdef __cplusplus
}
#endif
_LT_EOF
# Now try linking the two files.
mv conftest.$ac_objext conftstm.$ac_objext
lt_globsym_save_LIBS=$LIBS
lt_globsym_save_CFLAGS=$CFLAGS
LIBS="conftstm.$ac_objext"
CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag"
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
(eval $ac_link) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && test -s conftest${ac_exeext}; then
pipe_works=yes
fi
LIBS=$lt_globsym_save_LIBS
CFLAGS=$lt_globsym_save_CFLAGS
else
echo "cannot find nm_test_func in $nlist" >&5
fi
else
echo "cannot find nm_test_var in $nlist" >&5
fi
else
echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5
fi
else
echo "$progname: failed program was:" >&5
cat conftest.$ac_ext >&5
fi
rm -rf conftest* conftst*
# Do not use the global_symbol_pipe unless it works.
if test "$pipe_works" = yes; then
break
else
lt_cv_sys_global_symbol_pipe=
fi
done
fi
if test -z "$lt_cv_sys_global_symbol_pipe"; then
lt_cv_sys_global_symbol_to_cdecl=
fi
if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5
$as_echo "failed" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
$as_echo "ok" >&6; }
fi
# Response file support.
if test "$lt_cv_nm_interface" = "MS dumpbin"; then
nm_file_list_spec='@'
elif $NM --help 2>/dev/null | grep '[@]FILE' >/dev/null; then
nm_file_list_spec='@'
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysroot" >&5
$as_echo_n "checking for sysroot... " >&6; }
# Check whether --with-sysroot was given.
if test "${with_sysroot+set}" = set; then :
withval=$with_sysroot;
else
with_sysroot=no
fi
lt_sysroot=
case ${with_sysroot} in #(
yes)
if test "$GCC" = yes; then
lt_sysroot=`$CC --print-sysroot 2>/dev/null`
fi
;; #(
/*)
lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"`
;; #(
no|'')
;; #(
*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${with_sysroot}" >&5
$as_echo "${with_sysroot}" >&6; }
as_fn_error $? "The sysroot must be an absolute path." "$LINENO" 5
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${lt_sysroot:-no}" >&5
$as_echo "${lt_sysroot:-no}" >&6; }
# Check whether --enable-libtool-lock was given.
if test "${enable_libtool_lock+set}" = set; then :
enableval=$enable_libtool_lock;
fi
test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes
# Some flags need to be propagated to the compiler or linker for good
# libtool support.
case $host in
ia64-*-hpux*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then
case `/usr/bin/file conftest.$ac_objext` in
*ELF-32*)
HPUX_IA64_MODE="32"
;;
*ELF-64*)
HPUX_IA64_MODE="64"
;;
esac
fi
rm -rf conftest*
;;
*-*-irix6*)
# Find out which ABI we are using.
echo '#line '$LINENO' "configure"' > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then
if test "$lt_cv_prog_gnu_ld" = yes; then
case `/usr/bin/file conftest.$ac_objext` in
*32-bit*)
LD="${LD-ld} -melf32bsmip"
;;
*N32*)
LD="${LD-ld} -melf32bmipn32"
;;
*64-bit*)
LD="${LD-ld} -melf64bmip"
;;
esac
else
case `/usr/bin/file conftest.$ac_objext` in
*32-bit*)
LD="${LD-ld} -32"
;;
*N32*)
LD="${LD-ld} -n32"
;;
*64-bit*)
LD="${LD-ld} -64"
;;
esac
fi
fi
rm -rf conftest*
;;
x86_64-*kfreebsd*-gnu|x86_64-*linux*|ppc*-*linux*|powerpc*-*linux*| \
s390*-*linux*|s390*-*tpf*|sparc*-*linux*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then
case `/usr/bin/file conftest.o` in
*32-bit*)
case $host in
x86_64-*kfreebsd*-gnu)
LD="${LD-ld} -m elf_i386_fbsd"
;;
x86_64-*linux*)
LD="${LD-ld} -m elf_i386"
;;
ppc64-*linux*|powerpc64-*linux*)
LD="${LD-ld} -m elf32ppclinux"
;;
s390x-*linux*)
LD="${LD-ld} -m elf_s390"
;;
sparc64-*linux*)
LD="${LD-ld} -m elf32_sparc"
;;
esac
;;
*64-bit*)
case $host in
x86_64-*kfreebsd*-gnu)
LD="${LD-ld} -m elf_x86_64_fbsd"
;;
x86_64-*linux*)
LD="${LD-ld} -m elf_x86_64"
;;
ppc*-*linux*|powerpc*-*linux*)
LD="${LD-ld} -m elf64ppc"
;;
s390*-*linux*|s390*-*tpf*)
LD="${LD-ld} -m elf64_s390"
;;
sparc*-*linux*)
LD="${LD-ld} -m elf64_sparc"
;;
esac
;;
esac
fi
rm -rf conftest*
;;
*-*-sco3.2v5*)
# On SCO OpenServer 5, we need -belf to get full-featured binaries.
SAVE_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -belf"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5
$as_echo_n "checking whether the C compiler needs -belf... " >&6; }
if ${lt_cv_cc_needs_belf+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
lt_cv_cc_needs_belf=yes
else
lt_cv_cc_needs_belf=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5
$as_echo "$lt_cv_cc_needs_belf" >&6; }
if test x"$lt_cv_cc_needs_belf" != x"yes"; then
# this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
CFLAGS="$SAVE_CFLAGS"
fi
;;
*-*solaris*)
# Find out which ABI we are using.
echo 'int i;' > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }; then
case `/usr/bin/file conftest.o` in
*64-bit*)
case $lt_cv_prog_gnu_ld in
yes*)
case $host in
i?86-*-solaris*)
LD="${LD-ld} -m elf_x86_64"
;;
sparc*-*-solaris*)
LD="${LD-ld} -m elf64_sparc"
;;
esac
# GNU ld 2.21 introduced _sol2 emulations. Use them if available.
if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then
LD="${LD-ld}_sol2"
fi
;;
*)
if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then
LD="${LD-ld} -64"
fi
;;
esac
;;
esac
fi
rm -rf conftest*
;;
esac
need_locks="$enable_libtool_lock"
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}mt", so it can be a program name with args.
set dummy ${ac_tool_prefix}mt; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_MANIFEST_TOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$MANIFEST_TOOL"; then
ac_cv_prog_MANIFEST_TOOL="$MANIFEST_TOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_MANIFEST_TOOL="${ac_tool_prefix}mt"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
MANIFEST_TOOL=$ac_cv_prog_MANIFEST_TOOL
if test -n "$MANIFEST_TOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MANIFEST_TOOL" >&5
$as_echo "$MANIFEST_TOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_MANIFEST_TOOL"; then
ac_ct_MANIFEST_TOOL=$MANIFEST_TOOL
# Extract the first word of "mt", so it can be a program name with args.
set dummy mt; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_MANIFEST_TOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_MANIFEST_TOOL"; then
ac_cv_prog_ac_ct_MANIFEST_TOOL="$ac_ct_MANIFEST_TOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_MANIFEST_TOOL="mt"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_MANIFEST_TOOL=$ac_cv_prog_ac_ct_MANIFEST_TOOL
if test -n "$ac_ct_MANIFEST_TOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_MANIFEST_TOOL" >&5
$as_echo "$ac_ct_MANIFEST_TOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_MANIFEST_TOOL" = x; then
MANIFEST_TOOL=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
MANIFEST_TOOL=$ac_ct_MANIFEST_TOOL
fi
else
MANIFEST_TOOL="$ac_cv_prog_MANIFEST_TOOL"
fi
test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $MANIFEST_TOOL is a manifest tool" >&5
$as_echo_n "checking if $MANIFEST_TOOL is a manifest tool... " >&6; }
if ${lt_cv_path_mainfest_tool+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_path_mainfest_tool=no
echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&5
$MANIFEST_TOOL '-?' 2>conftest.err > conftest.out
cat conftest.err >&5
if $GREP 'Manifest Tool' conftest.out > /dev/null; then
lt_cv_path_mainfest_tool=yes
fi
rm -f conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_mainfest_tool" >&5
$as_echo "$lt_cv_path_mainfest_tool" >&6; }
if test "x$lt_cv_path_mainfest_tool" != xyes; then
MANIFEST_TOOL=:
fi
case $host_os in
rhapsody* | darwin*)
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args.
set dummy ${ac_tool_prefix}dsymutil; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_DSYMUTIL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$DSYMUTIL"; then
ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
DSYMUTIL=$ac_cv_prog_DSYMUTIL
if test -n "$DSYMUTIL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5
$as_echo "$DSYMUTIL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_DSYMUTIL"; then
ac_ct_DSYMUTIL=$DSYMUTIL
# Extract the first word of "dsymutil", so it can be a program name with args.
set dummy dsymutil; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_DSYMUTIL"; then
ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_DSYMUTIL="dsymutil"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL
if test -n "$ac_ct_DSYMUTIL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5
$as_echo "$ac_ct_DSYMUTIL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_DSYMUTIL" = x; then
DSYMUTIL=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
DSYMUTIL=$ac_ct_DSYMUTIL
fi
else
DSYMUTIL="$ac_cv_prog_DSYMUTIL"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args.
set dummy ${ac_tool_prefix}nmedit; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_NMEDIT+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$NMEDIT"; then
ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
NMEDIT=$ac_cv_prog_NMEDIT
if test -n "$NMEDIT"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5
$as_echo "$NMEDIT" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_NMEDIT"; then
ac_ct_NMEDIT=$NMEDIT
# Extract the first word of "nmedit", so it can be a program name with args.
set dummy nmedit; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_NMEDIT"; then
ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_NMEDIT="nmedit"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT
if test -n "$ac_ct_NMEDIT"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5
$as_echo "$ac_ct_NMEDIT" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_NMEDIT" = x; then
NMEDIT=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
NMEDIT=$ac_ct_NMEDIT
fi
else
NMEDIT="$ac_cv_prog_NMEDIT"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args.
set dummy ${ac_tool_prefix}lipo; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_LIPO+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$LIPO"; then
ac_cv_prog_LIPO="$LIPO" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_LIPO="${ac_tool_prefix}lipo"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
LIPO=$ac_cv_prog_LIPO
if test -n "$LIPO"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5
$as_echo "$LIPO" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_LIPO"; then
ac_ct_LIPO=$LIPO
# Extract the first word of "lipo", so it can be a program name with args.
set dummy lipo; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_LIPO+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_LIPO"; then
ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_LIPO="lipo"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO
if test -n "$ac_ct_LIPO"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5
$as_echo "$ac_ct_LIPO" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_LIPO" = x; then
LIPO=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
LIPO=$ac_ct_LIPO
fi
else
LIPO="$ac_cv_prog_LIPO"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args.
set dummy ${ac_tool_prefix}otool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_OTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$OTOOL"; then
ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OTOOL="${ac_tool_prefix}otool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
OTOOL=$ac_cv_prog_OTOOL
if test -n "$OTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5
$as_echo "$OTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_OTOOL"; then
ac_ct_OTOOL=$OTOOL
# Extract the first word of "otool", so it can be a program name with args.
set dummy otool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_OTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_OTOOL"; then
ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_OTOOL="otool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL
if test -n "$ac_ct_OTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5
$as_echo "$ac_ct_OTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_OTOOL" = x; then
OTOOL=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
OTOOL=$ac_ct_OTOOL
fi
else
OTOOL="$ac_cv_prog_OTOOL"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args.
set dummy ${ac_tool_prefix}otool64; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_OTOOL64+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$OTOOL64"; then
ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
OTOOL64=$ac_cv_prog_OTOOL64
if test -n "$OTOOL64"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5
$as_echo "$OTOOL64" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_OTOOL64"; then
ac_ct_OTOOL64=$OTOOL64
# Extract the first word of "otool64", so it can be a program name with args.
set dummy otool64; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_OTOOL64"; then
ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_OTOOL64="otool64"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64
if test -n "$ac_ct_OTOOL64"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5
$as_echo "$ac_ct_OTOOL64" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_OTOOL64" = x; then
OTOOL64=":"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
OTOOL64=$ac_ct_OTOOL64
fi
else
OTOOL64="$ac_cv_prog_OTOOL64"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5
$as_echo_n "checking for -single_module linker flag... " >&6; }
if ${lt_cv_apple_cc_single_mod+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_apple_cc_single_mod=no
if test -z "${LT_MULTI_MODULE}"; then
# By default we will add the -single_module flag. You can override
# by either setting the environment variable LT_MULTI_MODULE
# non-empty at configure time, or by adding -multi_module to the
# link flags.
rm -rf libconftest.dylib*
echo "int foo(void){return 1;}" > conftest.c
echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
-dynamiclib -Wl,-single_module conftest.c" >&5
$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \
-dynamiclib -Wl,-single_module conftest.c 2>conftest.err
_lt_result=$?
# If there is a non-empty error log, and "single_module"
# appears in it, assume the flag caused a linker warning
if test -s conftest.err && $GREP single_module conftest.err; then
cat conftest.err >&5
# Otherwise, if the output was created with a 0 exit code from
# the compiler, it worked.
elif test -f libconftest.dylib && test $_lt_result -eq 0; then
lt_cv_apple_cc_single_mod=yes
else
cat conftest.err >&5
fi
rm -rf libconftest.dylib*
rm -f conftest.*
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5
$as_echo "$lt_cv_apple_cc_single_mod" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5
$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; }
if ${lt_cv_ld_exported_symbols_list+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_ld_exported_symbols_list=no
save_LDFLAGS=$LDFLAGS
echo "_main" > conftest.sym
LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
lt_cv_ld_exported_symbols_list=yes
else
lt_cv_ld_exported_symbols_list=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5
$as_echo "$lt_cv_ld_exported_symbols_list" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5
$as_echo_n "checking for -force_load linker flag... " >&6; }
if ${lt_cv_ld_force_load+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_ld_force_load=no
cat > conftest.c << _LT_EOF
int forced_loaded() { return 2;}
_LT_EOF
echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5
$LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5
echo "$AR cru libconftest.a conftest.o" >&5
$AR cru libconftest.a conftest.o 2>&5
echo "$RANLIB libconftest.a" >&5
$RANLIB libconftest.a 2>&5
cat > conftest.c << _LT_EOF
int main() { return 0;}
_LT_EOF
echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5
$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err
_lt_result=$?
if test -s conftest.err && $GREP force_load conftest.err; then
cat conftest.err >&5
elif test -f conftest && test $_lt_result -eq 0 && $GREP forced_load conftest >/dev/null 2>&1 ; then
lt_cv_ld_force_load=yes
else
cat conftest.err >&5
fi
rm -f conftest.err libconftest.a conftest conftest.c
rm -rf conftest.dSYM
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5
$as_echo "$lt_cv_ld_force_load" >&6; }
case $host_os in
rhapsody* | darwin1.[012])
_lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;;
darwin1.*)
_lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
darwin*) # darwin 5.x on
# if running on 10.5 or later, the deployment target defaults
# to the OS version, if on x86, and 10.4, the deployment
# target defaults to 10.4. Don't you love it?
case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in
10.0,*86*-darwin8*|10.0,*-darwin[91]*)
_lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
10.[012]*)
_lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;;
10.*)
_lt_dar_allow_undefined='${wl}-undefined ${wl}dynamic_lookup' ;;
esac
;;
esac
if test "$lt_cv_apple_cc_single_mod" = "yes"; then
_lt_dar_single_mod='$single_module'
fi
if test "$lt_cv_ld_exported_symbols_list" = "yes"; then
_lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym'
else
_lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}'
fi
if test "$DSYMUTIL" != ":" && test "$lt_cv_ld_force_load" = "no"; then
_lt_dsymutil='~$DSYMUTIL $lib || :'
else
_lt_dsymutil=
fi
;;
esac
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
$as_echo_n "checking how to run the C preprocessor... " >&6; }
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
fi
if test -z "$CPP"; then
if ${ac_cv_prog_CPP+:} false; then :
$as_echo_n "(cached) " >&6
else
# Double quotes because CPP needs to be expanded
for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
do
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
# Use a header file that comes with gcc, so configuring glibc
# with a fresh cross-compiler works.
# Prefer to if __STDC__ is defined, since
# exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include
#else
# include
#endif
Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
else
# Broken: fails on valid input.
continue
fi
rm -f conftest.err conftest.i conftest.$ac_ext
# OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
# Passes both tests.
ac_preproc_ok=:
break
fi
rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok; then :
break
fi
done
ac_cv_prog_CPP=$CPP
fi
CPP=$ac_cv_prog_CPP
else
ac_cv_prog_CPP=$CPP
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
$as_echo "$CPP" >&6; }
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
# Use a header file that comes with gcc, so configuring glibc
# with a fresh cross-compiler works.
# Prefer to if __STDC__ is defined, since
# exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include
#else
# include
#endif
Syntax error
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
else
# Broken: fails on valid input.
continue
fi
rm -f conftest.err conftest.i conftest.$ac_ext
# OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
# Passes both tests.
ac_preproc_ok=:
break
fi
rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok; then :
else
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
See \`config.log' for more details" "$LINENO" 5; }
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
$as_echo_n "checking for ANSI C header files... " >&6; }
if ${ac_cv_header_stdc+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
#include
#include
#include
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_header_stdc=yes
else
ac_cv_header_stdc=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
$EGREP "memchr" >/dev/null 2>&1; then :
else
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
$EGREP "free" >/dev/null 2>&1; then :
else
ac_cv_header_stdc=no
fi
rm -f conftest*
fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
if test "$cross_compiling" = yes; then :
:
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include
#include
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#else
# define ISLOWER(c) \
(('a' <= (c) && (c) <= 'i') \
|| ('j' <= (c) && (c) <= 'r') \
|| ('s' <= (c) && (c) <= 'z'))
# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
#endif
#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
int
main ()
{
int i;
for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i))
|| toupper (i) != TOUPPER (i))
return 2;
return 0;
}
_ACEOF
if ac_fn_c_try_run "$LINENO"; then :
else
ac_cv_header_stdc=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then
$as_echo "#define STDC_HEADERS 1" >>confdefs.h
fi
# On IRIX 5.3, sys/types and inttypes.h are conflicting.
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
inttypes.h stdint.h unistd.h
do :
as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
"
if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
fi
done
for ac_header in dlfcn.h
do :
ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default
"
if test "x$ac_cv_header_dlfcn_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_DLFCN_H 1
_ACEOF
fi
done
# Set options
enable_win32_dll=yes
case $host in
*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*)
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
set dummy ${ac_tool_prefix}as; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AS+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$AS"; then
ac_cv_prog_AS="$AS" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AS="${ac_tool_prefix}as"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
AS=$ac_cv_prog_AS
if test -n "$AS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $AS" >&5
$as_echo "$AS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_AS"; then
ac_ct_AS=$AS
# Extract the first word of "as", so it can be a program name with args.
set dummy as; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_AS+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_AS"; then
ac_cv_prog_ac_ct_AS="$ac_ct_AS" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_AS="as"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_AS=$ac_cv_prog_ac_ct_AS
if test -n "$ac_ct_AS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AS" >&5
$as_echo "$ac_ct_AS" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_AS" = x; then
AS="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
AS=$ac_ct_AS
fi
else
AS="$ac_cv_prog_AS"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
set dummy ${ac_tool_prefix}dlltool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_DLLTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$DLLTOOL"; then
ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
DLLTOOL=$ac_cv_prog_DLLTOOL
if test -n "$DLLTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5
$as_echo "$DLLTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_DLLTOOL"; then
ac_ct_DLLTOOL=$DLLTOOL
# Extract the first word of "dlltool", so it can be a program name with args.
set dummy dlltool; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_DLLTOOL"; then
ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_DLLTOOL="dlltool"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL
if test -n "$ac_ct_DLLTOOL"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5
$as_echo "$ac_ct_DLLTOOL" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_DLLTOOL" = x; then
DLLTOOL="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
DLLTOOL=$ac_ct_DLLTOOL
fi
else
DLLTOOL="$ac_cv_prog_DLLTOOL"
fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args.
set dummy ${ac_tool_prefix}objdump; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_OBJDUMP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$OBJDUMP"; then
ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
OBJDUMP=$ac_cv_prog_OBJDUMP
if test -n "$OBJDUMP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5
$as_echo "$OBJDUMP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
fi
if test -z "$ac_cv_prog_OBJDUMP"; then
ac_ct_OBJDUMP=$OBJDUMP
# Extract the first word of "objdump", so it can be a program name with args.
set dummy objdump; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_OBJDUMP"; then
ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_OBJDUMP="objdump"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP
if test -n "$ac_ct_OBJDUMP"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5
$as_echo "$ac_ct_OBJDUMP" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test "x$ac_ct_OBJDUMP" = x; then
OBJDUMP="false"
else
case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
OBJDUMP=$ac_ct_OBJDUMP
fi
else
OBJDUMP="$ac_cv_prog_OBJDUMP"
fi
;;
esac
test -z "$AS" && AS=as
test -z "$DLLTOOL" && DLLTOOL=dlltool
test -z "$OBJDUMP" && OBJDUMP=objdump
enable_dlopen=no
# Check whether --enable-shared was given.
if test "${enable_shared+set}" = set; then :
enableval=$enable_shared; p=${PACKAGE-default}
case $enableval in
yes) enable_shared=yes ;;
no) enable_shared=no ;;
*)
enable_shared=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_shared=yes
fi
done
IFS="$lt_save_ifs"
;;
esac
else
enable_shared=yes
fi
# Check whether --enable-static was given.
if test "${enable_static+set}" = set; then :
enableval=$enable_static; p=${PACKAGE-default}
case $enableval in
yes) enable_static=yes ;;
no) enable_static=no ;;
*)
enable_static=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_static=yes
fi
done
IFS="$lt_save_ifs"
;;
esac
else
enable_static=yes
fi
# Check whether --with-pic was given.
if test "${with_pic+set}" = set; then :
withval=$with_pic; lt_p=${PACKAGE-default}
case $withval in
yes|no) pic_mode=$withval ;;
*)
pic_mode=default
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for lt_pkg in $withval; do
IFS="$lt_save_ifs"
if test "X$lt_pkg" = "X$lt_p"; then
pic_mode=yes
fi
done
IFS="$lt_save_ifs"
;;
esac
else
pic_mode=default
fi
test -z "$pic_mode" && pic_mode=default
# Check whether --enable-fast-install was given.
if test "${enable_fast_install+set}" = set; then :
enableval=$enable_fast_install; p=${PACKAGE-default}
case $enableval in
yes) enable_fast_install=yes ;;
no) enable_fast_install=no ;;
*)
enable_fast_install=no
# Look at the argument we got. We use all the common list separators.
lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR,"
for pkg in $enableval; do
IFS="$lt_save_ifs"
if test "X$pkg" = "X$p"; then
enable_fast_install=yes
fi
done
IFS="$lt_save_ifs"
;;
esac
else
enable_fast_install=yes
fi
# This can be used to rebuild libtool when needed
LIBTOOL_DEPS="$ltmain"
# Always use our own libtool.
LIBTOOL='$(SHELL) $(top_builddir)/libtool'
test -z "$LN_S" && LN_S="ln -s"
if test -n "${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5
$as_echo_n "checking for objdir... " >&6; }
if ${lt_cv_objdir+:} false; then :
$as_echo_n "(cached) " >&6
else
rm -f .libs 2>/dev/null
mkdir .libs 2>/dev/null
if test -d .libs; then
lt_cv_objdir=.libs
else
# MS-DOS does not allow filenames that begin with a dot.
lt_cv_objdir=_libs
fi
rmdir .libs 2>/dev/null
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5
$as_echo "$lt_cv_objdir" >&6; }
objdir=$lt_cv_objdir
cat >>confdefs.h <<_ACEOF
#define LT_OBJDIR "$lt_cv_objdir/"
_ACEOF
case $host_os in
aix3*)
# AIX sometimes has problems with the GCC collect2 program. For some
# reason, if we set the COLLECT_NAMES environment variable, the problems
# vanish in a puff of smoke.
if test "X${COLLECT_NAMES+set}" != Xset; then
COLLECT_NAMES=
export COLLECT_NAMES
fi
;;
esac
# Global variables:
ofile=libtool
can_build_shared=yes
# All known linkers require a `.a' archive for static linking (except MSVC,
# which needs '.lib').
libext=a
with_gnu_ld="$lt_cv_prog_gnu_ld"
old_CC="$CC"
old_CFLAGS="$CFLAGS"
# Set sane defaults for various variables
test -z "$CC" && CC=cc
test -z "$LTCC" && LTCC=$CC
test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS
test -z "$LD" && LD=ld
test -z "$ac_objext" && ac_objext=o
for cc_temp in $compiler""; do
case $cc_temp in
compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
\-*) ;;
*) break;;
esac
done
cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
# Only perform the check for file, if the check method requires it
test -z "$MAGIC_CMD" && MAGIC_CMD=file
case $deplibs_check_method in
file_magic*)
if test "$file_magic_cmd" = '$MAGIC_CMD'; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5
$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; }
if ${lt_cv_path_MAGIC_CMD+:} false; then :
$as_echo_n "(cached) " >&6
else
case $MAGIC_CMD in
[\\/*] | ?:[\\/]*)
lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
;;
*)
lt_save_MAGIC_CMD="$MAGIC_CMD"
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
for ac_dir in $ac_dummy; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/${ac_tool_prefix}file; then
lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file"
if test -n "$file_magic_test_file"; then
case $deplibs_check_method in
"file_magic "*)
file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
$EGREP "$file_magic_regex" > /dev/null; then
:
else
cat <<_LT_EOF 1>&2
*** Warning: the command libtool uses to detect shared libraries,
*** $file_magic_cmd, produces output that libtool cannot recognize.
*** The result is that libtool may fail to recognize shared libraries
*** as such. This will affect the creation of libtool libraries that
*** depend on shared libraries, but programs linked with such libtool
*** libraries will work regardless of this problem. Nevertheless, you
*** may want to report the problem to your system manager and/or to
*** bug-libtool@gnu.org
_LT_EOF
fi ;;
esac
fi
break
fi
done
IFS="$lt_save_ifs"
MAGIC_CMD="$lt_save_MAGIC_CMD"
;;
esac
fi
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if test -n "$MAGIC_CMD"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
$as_echo "$MAGIC_CMD" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
if test -z "$lt_cv_path_MAGIC_CMD"; then
if test -n "$ac_tool_prefix"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5
$as_echo_n "checking for file... " >&6; }
if ${lt_cv_path_MAGIC_CMD+:} false; then :
$as_echo_n "(cached) " >&6
else
case $MAGIC_CMD in
[\\/*] | ?:[\\/]*)
lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path.
;;
*)
lt_save_MAGIC_CMD="$MAGIC_CMD"
lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR
ac_dummy="/usr/bin$PATH_SEPARATOR$PATH"
for ac_dir in $ac_dummy; do
IFS="$lt_save_ifs"
test -z "$ac_dir" && ac_dir=.
if test -f $ac_dir/file; then
lt_cv_path_MAGIC_CMD="$ac_dir/file"
if test -n "$file_magic_test_file"; then
case $deplibs_check_method in
"file_magic "*)
file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"`
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
$EGREP "$file_magic_regex" > /dev/null; then
:
else
cat <<_LT_EOF 1>&2
*** Warning: the command libtool uses to detect shared libraries,
*** $file_magic_cmd, produces output that libtool cannot recognize.
*** The result is that libtool may fail to recognize shared libraries
*** as such. This will affect the creation of libtool libraries that
*** depend on shared libraries, but programs linked with such libtool
*** libraries will work regardless of this problem. Nevertheless, you
*** may want to report the problem to your system manager and/or to
*** bug-libtool@gnu.org
_LT_EOF
fi ;;
esac
fi
break
fi
done
IFS="$lt_save_ifs"
MAGIC_CMD="$lt_save_MAGIC_CMD"
;;
esac
fi
MAGIC_CMD="$lt_cv_path_MAGIC_CMD"
if test -n "$MAGIC_CMD"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5
$as_echo "$MAGIC_CMD" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
else
MAGIC_CMD=:
fi
fi
fi
;;
esac
# Use C for the default configuration in the libtool script
lt_save_CC="$CC"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
# Source file extension for C test sources.
ac_ext=c
# Object file extension for compiled C test sources.
objext=o
objext=$objext
# Code to be used in simple compile tests
lt_simple_compile_test_code="int some_variable = 0;"
# Code to be used in simple link tests
lt_simple_link_test_code='int main(){return(0);}'
# If no C compiler was specified, use CC.
LTCC=${LTCC-"$CC"}
# If no C compiler flags were specified, use CFLAGS.
LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
# Allow CC to be a program name with arguments.
compiler=$CC
# Save the default compiler, since it gets overwritten when the other
# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP.
compiler_DEFAULT=$CC
# save warnings/boilerplate of simple test code
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" >conftest.$ac_ext
eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_compiler_boilerplate=`cat conftest.err`
$RM conftest*
ac_outfile=conftest.$ac_objext
echo "$lt_simple_link_test_code" >conftest.$ac_ext
eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_linker_boilerplate=`cat conftest.err`
$RM -r conftest*
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
if test -n "$compiler"; then
lt_prog_compiler_no_builtin_flag=
if test "$GCC" = yes; then
case $cc_basename in
nvcc*)
lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;;
*)
lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; }
if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_rtti_exceptions=no
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-fno-rtti -fno-exceptions"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
# The option is referenced via a variable to avoid confusing sed.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler_rtti_exceptions=yes
fi
fi
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5
$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; }
if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then
lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions"
else
:
fi
fi
lt_prog_compiler_wl=
lt_prog_compiler_pic=
lt_prog_compiler_static=
if test "$GCC" = yes; then
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_static='-static'
case $host_os in
aix*)
# All AIX code is PIC.
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
lt_prog_compiler_static='-Bstatic'
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
lt_prog_compiler_pic='-fPIC'
;;
m68k)
# FIXME: we need at least 68020 code to build shared libraries, but
# adding the `-m68020' flag to GCC prevents building anything better,
# like `-m68040'.
lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4'
;;
esac
;;
beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
# PIC is the default for these OSes.
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
# Although the cygwin gcc ignores -fPIC, still need this for old-style
# (--disable-auto-import) libraries
lt_prog_compiler_pic='-DDLL_EXPORT'
;;
darwin* | rhapsody*)
# PIC is the default on this platform
# Common symbols not allowed in MH_DYLIB files
lt_prog_compiler_pic='-fno-common'
;;
haiku*)
# PIC is the default for Haiku.
# The "-static" flag exists, but is broken.
lt_prog_compiler_static=
;;
hpux*)
# PIC is the default for 64-bit PA HP-UX, but not for 32-bit
# PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
# sets the default TLS model and affects inlining.
case $host_cpu in
hppa*64*)
# +Z the default
;;
*)
lt_prog_compiler_pic='-fPIC'
;;
esac
;;
interix[3-9]*)
# Interix 3.x gcc -fpic/-fPIC options generate broken code.
# Instead, we relocate shared libraries at runtime.
;;
msdosdjgpp*)
# Just because we use GCC doesn't mean we suddenly get shared libraries
# on systems that don't support them.
lt_prog_compiler_can_build_shared=no
enable_shared=no
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
lt_prog_compiler_pic='-fPIC -shared'
;;
sysv4*MP*)
if test -d /usr/nec; then
lt_prog_compiler_pic=-Kconform_pic
fi
;;
*)
lt_prog_compiler_pic='-fPIC'
;;
esac
case $cc_basename in
nvcc*) # Cuda Compiler Driver 2.2
lt_prog_compiler_wl='-Xlinker '
if test -n "$lt_prog_compiler_pic"; then
lt_prog_compiler_pic="-Xcompiler $lt_prog_compiler_pic"
fi
;;
esac
else
# PORTME Check for flag to pass linker flags through the system compiler.
case $host_os in
aix*)
lt_prog_compiler_wl='-Wl,'
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
lt_prog_compiler_static='-Bstatic'
else
lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp'
fi
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
lt_prog_compiler_pic='-DDLL_EXPORT'
;;
hpux9* | hpux10* | hpux11*)
lt_prog_compiler_wl='-Wl,'
# PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
# not for PA HP-UX.
case $host_cpu in
hppa*64*|ia64*)
# +Z the default
;;
*)
lt_prog_compiler_pic='+Z'
;;
esac
# Is there a better lt_prog_compiler_static that works with the bundled CC?
lt_prog_compiler_static='${wl}-a ${wl}archive'
;;
irix5* | irix6* | nonstopux*)
lt_prog_compiler_wl='-Wl,'
# PIC (with -KPIC) is the default.
lt_prog_compiler_static='-non_shared'
;;
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
# old Intel for x86_64 which still supported -KPIC.
ecc*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-static'
;;
# icc used to be incompatible with GCC.
# ICC 10 doesn't accept -KPIC any more.
icc* | ifort*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-fPIC'
lt_prog_compiler_static='-static'
;;
# Lahey Fortran 8.1.
lf95*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='--shared'
lt_prog_compiler_static='--static'
;;
nagfor*)
# NAG Fortran compiler
lt_prog_compiler_wl='-Wl,-Wl,,'
lt_prog_compiler_pic='-PIC'
lt_prog_compiler_static='-Bstatic'
;;
pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group compilers (*not* the Pentium gcc compiler,
# which looks to be a dead project)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-fpic'
lt_prog_compiler_static='-Bstatic'
;;
ccc*)
lt_prog_compiler_wl='-Wl,'
# All Alpha code is PIC.
lt_prog_compiler_static='-non_shared'
;;
xl* | bgxl* | bgf* | mpixl*)
# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-qpic'
lt_prog_compiler_static='-qstaticlink'
;;
*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*)
# Sun Fortran 8.3 passes all unrecognized flags to the linker
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
lt_prog_compiler_wl=''
;;
*Sun\ F* | *Sun*Fortran*)
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
lt_prog_compiler_wl='-Qoption ld '
;;
*Sun\ C*)
# Sun C 5.9
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
lt_prog_compiler_wl='-Wl,'
;;
*Intel*\ [CF]*Compiler*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-fPIC'
lt_prog_compiler_static='-static'
;;
*Portland\ Group*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-fpic'
lt_prog_compiler_static='-Bstatic'
;;
esac
;;
esac
;;
newsos6)
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
lt_prog_compiler_pic='-fPIC -shared'
;;
osf3* | osf4* | osf5*)
lt_prog_compiler_wl='-Wl,'
# All OSF/1 code is PIC.
lt_prog_compiler_static='-non_shared'
;;
rdos*)
lt_prog_compiler_static='-non_shared'
;;
solaris*)
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
case $cc_basename in
f77* | f90* | f95* | sunf77* | sunf90* | sunf95*)
lt_prog_compiler_wl='-Qoption ld ';;
*)
lt_prog_compiler_wl='-Wl,';;
esac
;;
sunos4*)
lt_prog_compiler_wl='-Qoption ld '
lt_prog_compiler_pic='-PIC'
lt_prog_compiler_static='-Bstatic'
;;
sysv4 | sysv4.2uw2* | sysv4.3*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
;;
sysv4*MP*)
if test -d /usr/nec ;then
lt_prog_compiler_pic='-Kconform_pic'
lt_prog_compiler_static='-Bstatic'
fi
;;
sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_pic='-KPIC'
lt_prog_compiler_static='-Bstatic'
;;
unicos*)
lt_prog_compiler_wl='-Wl,'
lt_prog_compiler_can_build_shared=no
;;
uts4*)
lt_prog_compiler_pic='-pic'
lt_prog_compiler_static='-Bstatic'
;;
*)
lt_prog_compiler_can_build_shared=no
;;
esac
fi
case $host_os in
# For platforms which do not support PIC, -DPIC is meaningless:
*djgpp*)
lt_prog_compiler_pic=
;;
*)
lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC"
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5
$as_echo_n "checking for $compiler option to produce PIC... " >&6; }
if ${lt_cv_prog_compiler_pic+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_pic=$lt_prog_compiler_pic
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic" >&5
$as_echo "$lt_cv_prog_compiler_pic" >&6; }
lt_prog_compiler_pic=$lt_cv_prog_compiler_pic
#
# Check to make sure the PIC flag actually works.
#
if test -n "$lt_prog_compiler_pic"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5
$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; }
if ${lt_cv_prog_compiler_pic_works+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_pic_works=no
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="$lt_prog_compiler_pic -DPIC"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
# The option is referenced via a variable to avoid confusing sed.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler_pic_works=yes
fi
fi
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5
$as_echo "$lt_cv_prog_compiler_pic_works" >&6; }
if test x"$lt_cv_prog_compiler_pic_works" = xyes; then
case $lt_prog_compiler_pic in
"" | " "*) ;;
*) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;;
esac
else
lt_prog_compiler_pic=
lt_prog_compiler_can_build_shared=no
fi
fi
#
# Check to make sure the static flag actually works.
#
wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5
$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; }
if ${lt_cv_prog_compiler_static_works+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_static_works=no
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS $lt_tmp_static_flag"
echo "$lt_simple_link_test_code" > conftest.$ac_ext
if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
# The linker can only warn and ignore the option if not recognized
# So say no if there are warnings
if test -s conftest.err; then
# Append any errors to the config.log.
cat conftest.err 1>&5
$ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler_static_works=yes
fi
else
lt_cv_prog_compiler_static_works=yes
fi
fi
$RM -r conftest*
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5
$as_echo "$lt_cv_prog_compiler_static_works" >&6; }
if test x"$lt_cv_prog_compiler_static_works" = xyes; then
:
else
lt_prog_compiler_static=
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
if ${lt_cv_prog_compiler_c_o+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_c_o=no
$RM -r conftest 2>/dev/null
mkdir conftest
cd conftest
mkdir out
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-o out/conftest2.$ac_objext"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
$SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
lt_cv_prog_compiler_c_o=yes
fi
fi
chmod u+w . 2>&5
$RM conftest*
# SGI C++ compiler will create directory out/ii_files/ for
# template instantiation
test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
$RM out/* && rmdir out
cd ..
$RM -r conftest
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
if ${lt_cv_prog_compiler_c_o+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_c_o=no
$RM -r conftest 2>/dev/null
mkdir conftest
cd conftest
mkdir out
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-o out/conftest2.$ac_objext"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
$SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
lt_cv_prog_compiler_c_o=yes
fi
fi
chmod u+w . 2>&5
$RM conftest*
# SGI C++ compiler will create directory out/ii_files/ for
# template instantiation
test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
$RM out/* && rmdir out
cd ..
$RM -r conftest
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5
$as_echo "$lt_cv_prog_compiler_c_o" >&6; }
hard_links="nottested"
if test "$lt_cv_prog_compiler_c_o" = no && test "$need_locks" != no; then
# do not overwrite the value of need_locks provided by the user
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5
$as_echo_n "checking if we can lock with hard links... " >&6; }
hard_links=yes
$RM conftest*
ln conftest.a conftest.b 2>/dev/null && hard_links=no
touch conftest.a
ln conftest.a conftest.b 2>&5 || hard_links=no
ln conftest.a conftest.b 2>/dev/null && hard_links=no
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5
$as_echo "$hard_links" >&6; }
if test "$hard_links" = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5
$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;}
need_locks=warn
fi
else
need_locks=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
runpath_var=
allow_undefined_flag=
always_export_symbols=no
archive_cmds=
archive_expsym_cmds=
compiler_needs_object=no
enable_shared_with_static_runtimes=no
export_dynamic_flag_spec=
export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
hardcode_automatic=no
hardcode_direct=no
hardcode_direct_absolute=no
hardcode_libdir_flag_spec=
hardcode_libdir_separator=
hardcode_minus_L=no
hardcode_shlibpath_var=unsupported
inherit_rpath=no
link_all_deplibs=unknown
module_cmds=
module_expsym_cmds=
old_archive_from_new_cmds=
old_archive_from_expsyms_cmds=
thread_safe_flag_spec=
whole_archive_flag_spec=
# include_expsyms should be a list of space-separated symbols to be *always*
# included in the symbol list
include_expsyms=
# exclude_expsyms can be an extended regexp of symbols to exclude
# it will be wrapped by ` (' and `)$', so one must not match beginning or
# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
# as well as any symbol that contains `d'.
exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'
# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
# platforms (ab)use it in PIC code, but their linkers get confused if
# the symbol is explicitly referenced. Since portable code cannot
# rely on this symbol name, it's probably fine to never include it in
# preloaded symbol tables.
# Exclude shared library initialization/finalization symbols.
extract_expsyms_cmds=
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
# FIXME: the MSVC++ port hasn't been tested in a loooong time
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
if test "$GCC" != yes; then
with_gnu_ld=no
fi
;;
interix*)
# we just hope/assume this is gcc and not c89 (= MSVC++)
with_gnu_ld=yes
;;
openbsd*)
with_gnu_ld=no
;;
esac
ld_shlibs=yes
# On some targets, GNU ld is compatible enough with the native linker
# that we're better off using the native interface for both.
lt_use_gnu_ld_interface=no
if test "$with_gnu_ld" = yes; then
case $host_os in
aix*)
# The AIX port of GNU ld has always aspired to compatibility
# with the native linker. However, as the warning in the GNU ld
# block says, versions before 2.19.5* couldn't really create working
# shared libraries, regardless of the interface used.
case `$LD -v 2>&1` in
*\ \(GNU\ Binutils\)\ 2.19.5*) ;;
*\ \(GNU\ Binutils\)\ 2.[2-9]*) ;;
*\ \(GNU\ Binutils\)\ [3-9]*) ;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
fi
if test "$lt_use_gnu_ld_interface" = yes; then
# If archive_cmds runs LD, not CC, wlarc should be empty
wlarc='${wl}'
# Set some defaults for GNU ld with shared library support. These
# are reset later if shared libraries are not supported. Putting them
# here allows them to be overridden if necessary.
runpath_var=LD_RUN_PATH
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
export_dynamic_flag_spec='${wl}--export-dynamic'
# ancient GNU ld didn't support --whole-archive et. al.
if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
else
whole_archive_flag_spec=
fi
supports_anon_versioning=no
case `$LD -v 2>&1` in
*GNU\ gold*) supports_anon_versioning=yes ;;
*\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11
*\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
*\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
*\ 2.11.*) ;; # other 2.11 versions
*) supports_anon_versioning=yes ;;
esac
# See if GNU ld supports shared libraries.
case $host_os in
aix[3-9]*)
# On AIX/PPC, the GNU linker is very broken
if test "$host_cpu" != ia64; then
ld_shlibs=no
cat <<_LT_EOF 1>&2
*** Warning: the GNU linker, at least up to release 2.19, is reported
*** to be unable to reliably create shared libraries on AIX.
*** Therefore, libtool is disabling shared libraries support. If you
*** really care for shared libraries, you may want to install binutils
*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
*** You will then need to restart the configuration process.
_LT_EOF
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds=''
;;
m68k)
archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
hardcode_libdir_flag_spec='-L$libdir'
hardcode_minus_L=yes
;;
esac
;;
beos*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
allow_undefined_flag=unsupported
# Joseph Beckenbach says some releases of gcc
# support --undefined. This deserves some investigation. FIXME
archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
else
ld_shlibs=no
fi
;;
cygwin* | mingw* | pw32* | cegcc*)
# _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless,
# as there is no search path for DLLs.
hardcode_libdir_flag_spec='-L$libdir'
export_dynamic_flag_spec='${wl}--export-all-symbols'
allow_undefined_flag=unsupported
always_export_symbols=no
enable_shared_with_static_runtimes=yes
export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols'
exclude_expsyms='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname'
if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
# If the export-symbols file already is a .def file (1st line
# is EXPORTS), use it as is; otherwise, prepend...
archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
cp $export_symbols $output_objdir/$soname.def;
else
echo EXPORTS > $output_objdir/$soname.def;
cat $export_symbols >> $output_objdir/$soname.def;
fi~
$CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
else
ld_shlibs=no
fi
;;
haiku*)
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
link_all_deplibs=yes
;;
interix[3-9]*)
hardcode_direct=no
hardcode_shlibpath_var=no
hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
export_dynamic_flag_spec='${wl}-E'
# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
# Instead, shared libraries are loaded at an image base (0x10000000 by
# default) and relocated if they conflict, which is a slow very memory
# consuming and fragmenting process. To avoid this, we pick a random,
# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
# time. Moving up from 0x10000000 also allows more sbrk(2) space.
archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
tmp_diet=no
if test "$host_os" = linux-dietlibc; then
case $cc_basename in
diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn)
esac
fi
if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
&& test "$tmp_diet" = no
then
tmp_addflag=' $pic_flag'
tmp_sharedflag='-shared'
case $cc_basename,$host_cpu in
pgcc*) # Portland Group C compiler
whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag'
;;
pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group f77 and f90 compilers
whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag -Mnomain' ;;
ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64
tmp_addflag=' -i_dynamic' ;;
efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64
tmp_addflag=' -i_dynamic -nofor_main' ;;
ifc* | ifort*) # Intel Fortran compiler
tmp_addflag=' -nofor_main' ;;
lf95*) # Lahey Fortran 8.1
whole_archive_flag_spec=
tmp_sharedflag='--shared' ;;
xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below)
tmp_sharedflag='-qmkshrobj'
tmp_addflag= ;;
nvcc*) # Cuda Compiler Driver 2.2
whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
compiler_needs_object=yes
;;
esac
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*) # Sun C 5.9
whole_archive_flag_spec='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
compiler_needs_object=yes
tmp_sharedflag='-G' ;;
*Sun\ F*) # Sun Fortran 8.3
tmp_sharedflag='-G' ;;
esac
archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
fi
case $cc_basename in
xlf* | bgf* | bgxlf* | mpixlf*)
# IBM XL Fortran 10.1 on PPC cannot create shared libs itself
whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive'
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
fi
;;
esac
else
ld_shlibs=no
fi
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
wlarc=
else
archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
fi
;;
solaris*)
if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
ld_shlibs=no
cat <<_LT_EOF 1>&2
*** Warning: The releases 2.8.* of the GNU linker cannot reliably
*** create shared libraries on Solaris systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.9.1 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs=no
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
case `$LD -v 2>&1` in
*\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*)
ld_shlibs=no
cat <<_LT_EOF 1>&2
*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not
*** reliably create shared libraries on SCO systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.16.91.0.3 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
;;
*)
# For security reasons, it is highly recommended that you always
# use absolute paths for naming shared libraries, and exclude the
# DT_RUNPATH tag from executables and libraries. But doing so
# requires that you compile everything twice, which is a pain.
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs=no
fi
;;
esac
;;
sunos4*)
archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
wlarc=
hardcode_direct=yes
hardcode_shlibpath_var=no
;;
*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs=no
fi
;;
esac
if test "$ld_shlibs" = no; then
runpath_var=
hardcode_libdir_flag_spec=
export_dynamic_flag_spec=
whole_archive_flag_spec=
fi
else
# PORTME fill in a description of your system's linker (not GNU ld)
case $host_os in
aix3*)
allow_undefined_flag=unsupported
always_export_symbols=yes
archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
# Note: this linker hardcodes the directories in LIBPATH if there
# are no directories specified by -L.
hardcode_minus_L=yes
if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then
# Neither direct hardcoding nor static linking is supported with a
# broken collect2.
hardcode_direct=unsupported
fi
;;
aix[4-9]*)
if test "$host_cpu" = ia64; then
# On IA64, the linker does run time linking by default, so we don't
# have to do anything special.
aix_use_runtimelinking=no
exp_sym_flag='-Bexport'
no_entry_flag=""
else
# If we're using GNU nm, then we don't want the "-C" option.
# -C means demangle to AIX nm, but means don't demangle with GNU nm
# Also, AIX nm treats weak defined symbols like other global
# defined symbols, whereas GNU nm marks them as "W".
if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
else
export_symbols_cmds='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
fi
aix_use_runtimelinking=no
# Test if we are trying to use run time linking or normal
# AIX style linking. If -brtl is somewhere in LDFLAGS, we
# need to do runtime linking.
case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
for ld_flag in $LDFLAGS; do
if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
aix_use_runtimelinking=yes
break
fi
done
;;
esac
exp_sym_flag='-bexport'
no_entry_flag='-bnoentry'
fi
# When large executables or shared objects are built, AIX ld can
# have problems creating the table of contents. If linking a library
# or program results in "error TOC overflow" add -mminimal-toc to
# CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
# enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
archive_cmds=''
hardcode_direct=yes
hardcode_direct_absolute=yes
hardcode_libdir_separator=':'
link_all_deplibs=yes
file_list_spec='${wl}-f,'
if test "$GCC" = yes; then
case $host_os in aix4.[012]|aix4.[012].*)
# We only want to do this on AIX 4.2 and lower, the check
# below for broken collect2 doesn't work under 4.3+
collect2name=`${CC} -print-prog-name=collect2`
if test -f "$collect2name" &&
strings "$collect2name" | $GREP resolve_lib_name >/dev/null
then
# We have reworked collect2
:
else
# We have old collect2
hardcode_direct=unsupported
# It fails to find uninstalled libraries when the uninstalled
# path is not listed in the libpath. Setting hardcode_minus_L
# to unsupported forces relinking
hardcode_minus_L=yes
hardcode_libdir_flag_spec='-L$libdir'
hardcode_libdir_separator=
fi
;;
esac
shared_flag='-shared'
if test "$aix_use_runtimelinking" = yes; then
shared_flag="$shared_flag "'${wl}-G'
fi
else
# not using gcc
if test "$host_cpu" = ia64; then
# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
# chokes on -Wl,-G. The following line is correct:
shared_flag='-G'
else
if test "$aix_use_runtimelinking" = yes; then
shared_flag='${wl}-G'
else
shared_flag='${wl}-bM:SRE'
fi
fi
fi
export_dynamic_flag_spec='${wl}-bexpall'
# It seems that -bexpall does not export symbols beginning with
# underscore (_), so it is better to generate a list of symbols to export.
always_export_symbols=yes
if test "$aix_use_runtimelinking" = yes; then
# Warning - without using the other runtime loading flags (-brtl),
# -berok will link without error, but may produce a broken library.
allow_undefined_flag='-berok'
# Determine the default libpath from the value encoded in an
# empty executable.
if test "${lt_cv_aix_libpath+set}" = set; then
aix_libpath=$lt_cv_aix_libpath
else
if ${lt_cv_aix_libpath_+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
lt_aix_libpath_sed='
/Import File Strings/,/^$/ {
/^0/ {
s/^0 *\([^ ]*\) *$/\1/
p
}
}'
lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
# Check for a 64-bit object if we didn't find anything.
if test -z "$lt_cv_aix_libpath_"; then
lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
if test -z "$lt_cv_aix_libpath_"; then
lt_cv_aix_libpath_="/usr/lib:/lib"
fi
fi
aix_libpath=$lt_cv_aix_libpath_
fi
hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
else
if test "$host_cpu" = ia64; then
hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib'
allow_undefined_flag="-z nodefs"
archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
else
# Determine the default libpath from the value encoded in an
# empty executable.
if test "${lt_cv_aix_libpath+set}" = set; then
aix_libpath=$lt_cv_aix_libpath
else
if ${lt_cv_aix_libpath_+:} false; then :
$as_echo_n "(cached) " >&6
else
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
lt_aix_libpath_sed='
/Import File Strings/,/^$/ {
/^0/ {
s/^0 *\([^ ]*\) *$/\1/
p
}
}'
lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
# Check for a 64-bit object if we didn't find anything.
if test -z "$lt_cv_aix_libpath_"; then
lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
if test -z "$lt_cv_aix_libpath_"; then
lt_cv_aix_libpath_="/usr/lib:/lib"
fi
fi
aix_libpath=$lt_cv_aix_libpath_
fi
hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath"
# Warning - without using the other run time loading flags,
# -berok will link without error, but may produce a broken library.
no_undefined_flag=' ${wl}-bernotok'
allow_undefined_flag=' ${wl}-berok'
if test "$with_gnu_ld" = yes; then
# We only use this code for GNU lds that support --whole-archive.
whole_archive_flag_spec='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
else
# Exported symbols can be pulled into shared objects from archives
whole_archive_flag_spec='$convenience'
fi
archive_cmds_need_lc=yes
# This is similar to how AIX traditionally builds its shared libraries.
archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
fi
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds=''
;;
m68k)
archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
hardcode_libdir_flag_spec='-L$libdir'
hardcode_minus_L=yes
;;
esac
;;
bsdi[45]*)
export_dynamic_flag_spec=-rdynamic
;;
cygwin* | mingw* | pw32* | cegcc*)
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
# hardcode_libdir_flag_spec is actually meaningless, as there is
# no search path for DLLs.
case $cc_basename in
cl*)
# Native MSVC
hardcode_libdir_flag_spec=' '
allow_undefined_flag=unsupported
always_export_symbols=yes
file_list_spec='@'
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
archive_cmds='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-dll~linknames='
archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
sed -n -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' -e '1\\\!p' < $export_symbols > $output_objdir/$soname.exp;
else
sed -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' < $export_symbols > $output_objdir/$soname.exp;
fi~
$CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
linknames='
# The linker will not automatically build a static lib if we build a DLL.
# _LT_TAGVAR(old_archive_from_new_cmds, )='true'
enable_shared_with_static_runtimes=yes
exclude_expsyms='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols'
# Don't use ranlib
old_postinstall_cmds='chmod 644 $oldlib'
postlink_cmds='lt_outputfile="@OUTPUT@"~
lt_tool_outputfile="@TOOL_OUTPUT@"~
case $lt_outputfile in
*.exe|*.EXE) ;;
*)
lt_outputfile="$lt_outputfile.exe"
lt_tool_outputfile="$lt_tool_outputfile.exe"
;;
esac~
if test "$MANIFEST_TOOL" != ":" && test -f "$lt_outputfile.manifest"; then
$MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
$RM "$lt_outputfile.manifest";
fi'
;;
*)
# Assume MSVC wrapper
hardcode_libdir_flag_spec=' '
allow_undefined_flag=unsupported
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
# The linker will automatically build a .lib file if we build a DLL.
old_archive_from_new_cmds='true'
# FIXME: Should let the user specify the lib program.
old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs'
enable_shared_with_static_runtimes=yes
;;
esac
;;
darwin* | rhapsody*)
archive_cmds_need_lc=no
hardcode_direct=no
hardcode_automatic=yes
hardcode_shlibpath_var=unsupported
if test "$lt_cv_ld_force_load" = "yes"; then
whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
else
whole_archive_flag_spec=''
fi
link_all_deplibs=yes
allow_undefined_flag="$_lt_dar_allow_undefined"
case $cc_basename in
ifort*) _lt_dar_can_shared=yes ;;
*) _lt_dar_can_shared=$GCC ;;
esac
if test "$_lt_dar_can_shared" = "yes"; then
output_verbose_link_cmd=func_echo_all
archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
archive_expsym_cmds="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
module_expsym_cmds="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
else
ld_shlibs=no
fi
;;
dgux*)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec='-L$libdir'
hardcode_shlibpath_var=no
;;
# FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
# support. Future versions do this automatically, but an explicit c++rt0.o
# does not break anything, and helps significantly (at the cost of a little
# extra space).
freebsd2.2*)
archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
hardcode_libdir_flag_spec='-R$libdir'
hardcode_direct=yes
hardcode_shlibpath_var=no
;;
# Unfortunately, older versions of FreeBSD 2 do not have this feature.
freebsd2.*)
archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct=yes
hardcode_minus_L=yes
hardcode_shlibpath_var=no
;;
# FreeBSD 3 and greater uses gcc -shared to do shared libraries.
freebsd* | dragonfly*)
archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
hardcode_libdir_flag_spec='-R$libdir'
hardcode_direct=yes
hardcode_shlibpath_var=no
;;
hpux9*)
if test "$GCC" = yes; then
archive_cmds='$RM $output_objdir/$soname~$CC -shared $pic_flag ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
else
archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
fi
hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
hardcode_libdir_separator=:
hardcode_direct=yes
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L=yes
export_dynamic_flag_spec='${wl}-E'
;;
hpux10*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
archive_cmds='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
fi
if test "$with_gnu_ld" = no; then
hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
hardcode_libdir_separator=:
hardcode_direct=yes
hardcode_direct_absolute=yes
export_dynamic_flag_spec='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L=yes
fi
;;
hpux11*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
case $host_cpu in
hppa*64*)
archive_cmds='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
archive_cmds='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
archive_cmds='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
else
case $host_cpu in
hppa*64*)
archive_cmds='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
# Older versions of the 11.00 compiler do not understand -b yet
# (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does)
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5
$as_echo_n "checking if $CC understands -b... " >&6; }
if ${lt_cv_prog_compiler__b+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler__b=no
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS -b"
echo "$lt_simple_link_test_code" > conftest.$ac_ext
if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
# The linker can only warn and ignore the option if not recognized
# So say no if there are warnings
if test -s conftest.err; then
# Append any errors to the config.log.
cat conftest.err 1>&5
$ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler__b=yes
fi
else
lt_cv_prog_compiler__b=yes
fi
fi
$RM -r conftest*
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5
$as_echo "$lt_cv_prog_compiler__b" >&6; }
if test x"$lt_cv_prog_compiler__b" = xyes; then
archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
fi
;;
esac
fi
if test "$with_gnu_ld" = no; then
hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
hardcode_libdir_separator=:
case $host_cpu in
hppa*64*|ia64*)
hardcode_direct=no
hardcode_shlibpath_var=no
;;
*)
hardcode_direct=yes
hardcode_direct_absolute=yes
export_dynamic_flag_spec='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L=yes
;;
esac
fi
;;
irix5* | irix6* | nonstopux*)
if test "$GCC" = yes; then
archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
# Try to use the -exported_symbol ld option, if it does not
# work, assume that -exports_file does not work either and
# implicitly export all symbols.
# This should be the same for all languages, so no per-tag cache variable.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5
$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; }
if ${lt_cv_irix_exported_symbol+:} false; then :
$as_echo_n "(cached) " >&6
else
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int foo (void) { return 0; }
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
lt_cv_irix_exported_symbol=yes
else
lt_cv_irix_exported_symbol=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5
$as_echo "$lt_cv_irix_exported_symbol" >&6; }
if test "$lt_cv_irix_exported_symbol" = yes; then
archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib'
fi
else
archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib'
fi
archive_cmds_need_lc='no'
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator=:
inherit_rpath=yes
link_all_deplibs=yes
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
else
archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
fi
hardcode_libdir_flag_spec='-R$libdir'
hardcode_direct=yes
hardcode_shlibpath_var=no
;;
newsos6)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct=yes
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator=:
hardcode_shlibpath_var=no
;;
*nto* | *qnx*)
;;
openbsd*)
if test -f /usr/libexec/ld.so; then
hardcode_direct=yes
hardcode_shlibpath_var=no
hardcode_direct_absolute=yes
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols'
hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
export_dynamic_flag_spec='${wl}-E'
else
case $host_os in
openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec='-R$libdir'
;;
*)
archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
hardcode_libdir_flag_spec='${wl}-rpath,$libdir'
;;
esac
fi
else
ld_shlibs=no
fi
;;
os2*)
hardcode_libdir_flag_spec='-L$libdir'
hardcode_minus_L=yes
allow_undefined_flag=unsupported
archive_cmds='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
;;
osf3*)
if test "$GCC" = yes; then
allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
else
allow_undefined_flag=' -expect_unresolved \*'
archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
fi
archive_cmds_need_lc='no'
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator=:
;;
osf4* | osf5*) # as osf3* with the addition of -msym flag
if test "$GCC" = yes; then
allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
archive_cmds='$CC -shared${allow_undefined_flag} $pic_flag $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
else
allow_undefined_flag=' -expect_unresolved \*'
archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
$CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp'
# Both c and cxx compiler support -rpath directly
hardcode_libdir_flag_spec='-rpath $libdir'
fi
archive_cmds_need_lc='no'
hardcode_libdir_separator=:
;;
solaris*)
no_undefined_flag=' -z defs'
if test "$GCC" = yes; then
wlarc='${wl}'
archive_cmds='$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
else
case `$CC -V 2>&1` in
*"Compilers 5.0"*)
wlarc=''
archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
;;
*)
wlarc='${wl}'
archive_cmds='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
;;
esac
fi
hardcode_libdir_flag_spec='-R$libdir'
hardcode_shlibpath_var=no
case $host_os in
solaris2.[0-5] | solaris2.[0-5].*) ;;
*)
# The compiler driver will combine and reorder linker options,
# but understands `-z linker_flag'. GCC discards it without `$wl',
# but is careful enough not to reorder.
# Supported since Solaris 2.6 (maybe 2.5.1?)
if test "$GCC" = yes; then
whole_archive_flag_spec='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
else
whole_archive_flag_spec='-z allextract$convenience -z defaultextract'
fi
;;
esac
link_all_deplibs=yes
;;
sunos4*)
if test "x$host_vendor" = xsequent; then
# Use $CC to link under sequent, because it throws in some extra .o
# files that make .init and .fini sections work.
archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
fi
hardcode_libdir_flag_spec='-L$libdir'
hardcode_direct=yes
hardcode_minus_L=yes
hardcode_shlibpath_var=no
;;
sysv4)
case $host_vendor in
sni)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct=yes # is this really true???
;;
siemens)
## LD is ld it makes a PLAMLIB
## CC just makes a GrossModule.
archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
reload_cmds='$CC -r -o $output$reload_objs'
hardcode_direct=no
;;
motorola)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct=no #Motorola manual says yes, but my tests say they lie
;;
esac
runpath_var='LD_RUN_PATH'
hardcode_shlibpath_var=no
;;
sysv4.3*)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_shlibpath_var=no
export_dynamic_flag_spec='-Bexport'
;;
sysv4*MP*)
if test -d /usr/nec; then
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_shlibpath_var=no
runpath_var=LD_RUN_PATH
hardcode_runpath_var=yes
ld_shlibs=yes
fi
;;
sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
no_undefined_flag='${wl}-z,text'
archive_cmds_need_lc=no
hardcode_shlibpath_var=no
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
sysv5* | sco3.2v5* | sco5v6*)
# Note: We can NOT use -z defs as we might desire, because we do not
# link with -lc, and that would cause any symbols used from libc to
# always be unresolved, which means just about no library would
# ever link correctly. If we're not using GNU ld we use -z text
# though, which does catch some bad symbols but isn't as heavy-handed
# as -z defs.
no_undefined_flag='${wl}-z,text'
allow_undefined_flag='${wl}-z,nodefs'
archive_cmds_need_lc=no
hardcode_shlibpath_var=no
hardcode_libdir_flag_spec='${wl}-R,$libdir'
hardcode_libdir_separator=':'
link_all_deplibs=yes
export_dynamic_flag_spec='${wl}-Bexport'
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
uts4*)
archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec='-L$libdir'
hardcode_shlibpath_var=no
;;
*)
ld_shlibs=no
;;
esac
if test x$host_vendor = xsni; then
case $host in
sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
export_dynamic_flag_spec='${wl}-Blargedynsym'
;;
esac
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5
$as_echo "$ld_shlibs" >&6; }
test "$ld_shlibs" = no && can_build_shared=no
with_gnu_ld=$with_gnu_ld
#
# Do we need to explicitly link libc?
#
case "x$archive_cmds_need_lc" in
x|xyes)
# Assume -lc should be added
archive_cmds_need_lc=yes
if test "$enable_shared" = yes && test "$GCC" = yes; then
case $archive_cmds in
*'~'*)
# FIXME: we may have to deal with multi-command sequences.
;;
'$CC '*)
# Test whether the compiler implicitly links with -lc since on some
# systems, -lgcc has to come before -lc. If gcc already passes -lc
# to ld, don't add -lc before -lgcc.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5
$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; }
if ${lt_cv_archive_cmds_need_lc+:} false; then :
$as_echo_n "(cached) " >&6
else
$RM conftest*
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } 2>conftest.err; then
soname=conftest
lib=conftest
libobjs=conftest.$ac_objext
deplibs=
wl=$lt_prog_compiler_wl
pic_flag=$lt_prog_compiler_pic
compiler_flags=-v
linker_flags=-v
verstring=
output_objdir=.
libname=conftest
lt_save_allow_undefined_flag=$allow_undefined_flag
allow_undefined_flag=
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5
(eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
then
lt_cv_archive_cmds_need_lc=no
else
lt_cv_archive_cmds_need_lc=yes
fi
allow_undefined_flag=$lt_save_allow_undefined_flag
else
cat conftest.err 1>&5
fi
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5
$as_echo "$lt_cv_archive_cmds_need_lc" >&6; }
archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc
;;
esac
fi
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5
$as_echo_n "checking dynamic linker characteristics... " >&6; }
if test "$GCC" = yes; then
case $host_os in
darwin*) lt_awk_arg="/^libraries:/,/LR/" ;;
*) lt_awk_arg="/^libraries:/" ;;
esac
case $host_os in
mingw* | cegcc*) lt_sed_strip_eq="s,=\([A-Za-z]:\),\1,g" ;;
*) lt_sed_strip_eq="s,=/,/,g" ;;
esac
lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq`
case $lt_search_path_spec in
*\;*)
# if the path contains ";" then we assume it to be the separator
# otherwise default to the standard path separator (i.e. ":") - it is
# assumed that no part of a normal pathname contains ";" but that should
# okay in the real world where ";" in dirpaths is itself problematic.
lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'`
;;
*)
lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"`
;;
esac
# Ok, now we have the path, separated by spaces, we can step through it
# and add multilib dir if necessary.
lt_tmp_lt_search_path_spec=
lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null`
for lt_sys_path in $lt_search_path_spec; do
if test -d "$lt_sys_path/$lt_multi_os_dir"; then
lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir"
else
test -d "$lt_sys_path" && \
lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path"
fi
done
lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk '
BEGIN {RS=" "; FS="/|\n";} {
lt_foo="";
lt_count=0;
for (lt_i = NF; lt_i > 0; lt_i--) {
if ($lt_i != "" && $lt_i != ".") {
if ($lt_i == "..") {
lt_count++;
} else {
if (lt_count == 0) {
lt_foo="/" $lt_i lt_foo;
} else {
lt_count--;
}
}
}
}
if (lt_foo != "") { lt_freq[lt_foo]++; }
if (lt_freq[lt_foo] == 1) { print lt_foo; }
}'`
# AWK program above erroneously prepends '/' to C:/dos/paths
# for these hosts.
case $host_os in
mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\
$SED 's,/\([A-Za-z]:\),\1,g'` ;;
esac
sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP`
else
sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
fi
library_names_spec=
libname_spec='lib$name'
soname_spec=
shrext_cmds=".so"
postinstall_cmds=
postuninstall_cmds=
finish_cmds=
finish_eval=
shlibpath_var=
shlibpath_overrides_runpath=unknown
version_type=none
dynamic_linker="$host_os ld.so"
sys_lib_dlsearch_path_spec="/lib /usr/lib"
need_lib_prefix=unknown
hardcode_into_libs=no
# when you set need_version to no, make sure it does not cause -set_version
# flags to be left without arguments
need_version=unknown
case $host_os in
aix3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
shlibpath_var=LIBPATH
# AIX 3 has no versioning support, so we append a major version to the name.
soname_spec='${libname}${release}${shared_ext}$major'
;;
aix[4-9]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
hardcode_into_libs=yes
if test "$host_cpu" = ia64; then
# AIX 5 supports IA64
library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
else
# With GCC up to 2.95.x, collect2 would create an import file
# for dependence libraries. The import file would start with
# the line `#! .'. This would cause the generated library to
# depend on `.', always an invalid library. This was fixed in
# development snapshots of GCC prior to 3.0.
case $host_os in
aix4 | aix4.[01] | aix4.[01].*)
if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
echo ' yes '
echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
:
else
can_build_shared=no
fi
;;
esac
# AIX (on Power*) has no versioning support, so currently we can not hardcode correct
# soname into executable. Probably we can add versioning support to
# collect2, so additional links can be useful in future.
if test "$aix_use_runtimelinking" = yes; then
# If using run time linking (on AIX 4.2 or later) use lib.so
# instead of lib.a to let people know that these are not
# typical AIX shared libraries.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
else
# We preserve .a as extension for shared libraries through AIX4.2
# and later when we are not doing run time linking.
library_names_spec='${libname}${release}.a $libname.a'
soname_spec='${libname}${release}${shared_ext}$major'
fi
shlibpath_var=LIBPATH
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# Since July 2007 AmigaOS4 officially supports .so libraries.
# When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
;;
m68k)
library_names_spec='$libname.ixlibrary $libname.a'
# Create ${libname}_ixlibrary.a entries in /sys/libs.
finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
;;
esac
;;
beos*)
library_names_spec='${libname}${shared_ext}'
dynamic_linker="$host_os ld.so"
shlibpath_var=LIBRARY_PATH
;;
bsdi[45]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
# the default ld.so.conf also contains /usr/contrib/lib and
# /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
# libtool to hard-code these into programs
;;
cygwin* | mingw* | pw32* | cegcc*)
version_type=windows
shrext_cmds=".dll"
need_version=no
need_lib_prefix=no
case $GCC,$cc_basename in
yes,*)
# gcc
library_names_spec='$libname.dll.a'
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname~
chmod a+x \$dldir/$dlname~
if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
fi'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
case $host_os in
cygwin*)
# Cygwin DLLs use 'cyg' prefix rather than 'lib'
soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"
;;
mingw* | cegcc*)
# MinGW DLLs use traditional 'lib' prefix
soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
;;
pw32*)
# pw32 DLLs use 'pw' prefix rather than 'lib'
library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
;;
esac
dynamic_linker='Win32 ld.exe'
;;
*,cl*)
# Native MSVC
libname_spec='$name'
soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
library_names_spec='${libname}.dll.lib'
case $build_os in
mingw*)
sys_lib_search_path_spec=
lt_save_ifs=$IFS
IFS=';'
for lt_path in $LIB
do
IFS=$lt_save_ifs
# Let DOS variable expansion print the short 8.3 style file name.
lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"`
sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path"
done
IFS=$lt_save_ifs
# Convert to MSYS style.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'`
;;
cygwin*)
# Convert to unix form, then to dos form, then back to unix form
# but this time dos style (no spaces!) so that the unix form looks
# like /cygdrive/c/PROGRA~1:/cygdr...
sys_lib_search_path_spec=`cygpath --path --unix "$LIB"`
sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null`
sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
;;
*)
sys_lib_search_path_spec="$LIB"
if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then
# It is most probably a Windows format PATH.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
else
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
fi
# FIXME: find the short name or the path components, as spaces are
# common. (e.g. "Program Files" -> "PROGRA~1")
;;
esac
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
dynamic_linker='Win32 link.exe'
;;
*)
# Assume MSVC wrapper
library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib'
dynamic_linker='Win32 ld.exe'
;;
esac
# FIXME: first we should search . and the directory the executable is in
shlibpath_var=PATH
;;
darwin* | rhapsody*)
dynamic_linker="$host_os dyld"
version_type=darwin
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
soname_spec='${libname}${release}${major}$shared_ext'
shlibpath_overrides_runpath=yes
shlibpath_var=DYLD_LIBRARY_PATH
shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"
sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
;;
dgux*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
freebsd* | dragonfly*)
# DragonFly does not have aout. When/if they implement a new
# versioning mechanism, adjust this.
if test -x /usr/bin/objformat; then
objformat=`/usr/bin/objformat`
else
case $host_os in
freebsd[23].*) objformat=aout ;;
*) objformat=elf ;;
esac
fi
version_type=freebsd-$objformat
case $version_type in
freebsd-elf*)
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
need_version=no
need_lib_prefix=no
;;
freebsd-*)
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
need_version=yes
;;
esac
shlibpath_var=LD_LIBRARY_PATH
case $host_os in
freebsd2.*)
shlibpath_overrides_runpath=yes
;;
freebsd3.[01]* | freebsdelf3.[01]*)
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
freebsd3.[2-9]* | freebsdelf3.[2-9]* | \
freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1)
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
*) # from 4.6 on, and DragonFly
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
esac
;;
gnu*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
haiku*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
dynamic_linker="$host_os runtime_loader"
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LIBRARY_PATH
shlibpath_overrides_runpath=yes
sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib'
hardcode_into_libs=yes
;;
hpux9* | hpux10* | hpux11*)
# Give a soname corresponding to the major version so that dld.sl refuses to
# link against other versions.
version_type=sunos
need_lib_prefix=no
need_version=no
case $host_cpu in
ia64*)
shrext_cmds='.so'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.so"
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
if test "X$HPUX_IA64_MODE" = X32; then
sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
else
sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
fi
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
hppa*64*)
shrext_cmds='.sl'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.sl"
shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
*)
shrext_cmds='.sl'
dynamic_linker="$host_os dld.sl"
shlibpath_var=SHLIB_PATH
shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
;;
esac
# HP-UX runs *really* slowly unless shared libraries are mode 555, ...
postinstall_cmds='chmod 555 $lib'
# or fails outright, so override atomically:
install_override_mode=555
;;
interix[3-9]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
irix5* | irix6* | nonstopux*)
case $host_os in
nonstopux*) version_type=nonstopux ;;
*)
if test "$lt_cv_prog_gnu_ld" = yes; then
version_type=linux # correct to gnu/linux during the next big refactor
else
version_type=irix
fi ;;
esac
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
case $host_os in
irix5* | nonstopux*)
libsuff= shlibsuff=
;;
*)
case $LD in # libtool.m4 will add one of these switches to LD
*-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
libsuff= shlibsuff= libmagic=32-bit;;
*-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
libsuff=32 shlibsuff=N32 libmagic=N32;;
*-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
libsuff=64 shlibsuff=64 libmagic=64-bit;;
*) libsuff= shlibsuff= libmagic=never-match;;
esac
;;
esac
shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
shlibpath_overrides_runpath=no
sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
hardcode_into_libs=yes
;;
# No shared lib support for Linux oldld, aout, or coff.
linux*oldld* | linux*aout* | linux*coff*)
dynamic_linker=no
;;
# This must be glibc/ELF.
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
# Some binutils ld are patched to set DT_RUNPATH
if ${lt_cv_shlibpath_overrides_runpath+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_shlibpath_overrides_runpath=no
save_LDFLAGS=$LDFLAGS
save_libdir=$libdir
eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \
LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\""
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then :
lt_cv_shlibpath_overrides_runpath=yes
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS=$save_LDFLAGS
libdir=$save_libdir
fi
shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
# This implies no fast_install, which is unacceptable.
# Some rework will be needed to allow for fast_install
# before this can be enabled.
hardcode_into_libs=yes
# Add ABI-specific directories to the system library path.
sys_lib_dlsearch_path_spec="/lib64 /usr/lib64 /lib /usr/lib"
# Append ld.so.conf contents to the search path
if test -f /etc/ld.so.conf; then
lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
sys_lib_dlsearch_path_spec="$sys_lib_dlsearch_path_spec $lt_ld_extra"
fi
# We used to test for /lib/ld.so.1 and disable shared libraries on
# powerpc, because MkLinux only supported shared libraries with the
# GNU dynamic linker. Since this was broken with cross compilers,
# most powerpc-linux boxes support dynamic linking these days and
# people can always --disable-shared, the test was removed, and we
# assume the GNU/Linux dynamic linker is in use.
dynamic_linker='GNU/Linux ld.so'
;;
netbsd*)
version_type=sunos
need_lib_prefix=no
need_version=no
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
dynamic_linker='NetBSD (a.out) ld.so'
else
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='NetBSD ld.elf_so'
fi
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
newsos6)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
;;
*nto* | *qnx*)
version_type=qnx
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
dynamic_linker='ldqnx.so'
;;
openbsd*)
version_type=sunos
sys_lib_dlsearch_path_spec="/usr/lib"
need_lib_prefix=no
# Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
case $host_os in
openbsd3.3 | openbsd3.3.*) need_version=yes ;;
*) need_version=no ;;
esac
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
shlibpath_var=LD_LIBRARY_PATH
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
case $host_os in
openbsd2.[89] | openbsd2.[89].*)
shlibpath_overrides_runpath=no
;;
*)
shlibpath_overrides_runpath=yes
;;
esac
else
shlibpath_overrides_runpath=yes
fi
;;
os2*)
libname_spec='$name'
shrext_cmds=".dll"
need_lib_prefix=no
library_names_spec='$libname${shared_ext} $libname.a'
dynamic_linker='OS/2 ld.exe'
shlibpath_var=LIBPATH
;;
osf3* | osf4* | osf5*)
version_type=osf
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
;;
rdos*)
dynamic_linker=no
;;
solaris*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
# ldd complains unless libraries are executable
postinstall_cmds='chmod +x $lib'
;;
sunos4*)
version_type=sunos
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
if test "$with_gnu_ld" = yes; then
need_lib_prefix=no
fi
need_version=yes
;;
sysv4 | sysv4.3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
case $host_vendor in
sni)
shlibpath_overrides_runpath=no
need_lib_prefix=no
runpath_var=LD_RUN_PATH
;;
siemens)
need_lib_prefix=no
;;
motorola)
need_lib_prefix=no
need_version=no
shlibpath_overrides_runpath=no
sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
;;
esac
;;
sysv4*MP*)
if test -d /usr/nec ;then
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
soname_spec='$libname${shared_ext}.$major'
shlibpath_var=LD_LIBRARY_PATH
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
version_type=freebsd-elf
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
if test "$with_gnu_ld" = yes; then
sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
else
sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
case $host_os in
sco3.2v5*)
sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
;;
esac
fi
sys_lib_dlsearch_path_spec='/usr/lib'
;;
tpf*)
# TPF is a cross-target only. Preferred cross-host = GNU/Linux.
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
uts4*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
*)
dynamic_linker=no
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5
$as_echo "$dynamic_linker" >&6; }
test "$dynamic_linker" = no && can_build_shared=no
variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
if test "$GCC" = yes; then
variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
fi
if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
fi
if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5
$as_echo_n "checking how to hardcode library paths into programs... " >&6; }
hardcode_action=
if test -n "$hardcode_libdir_flag_spec" ||
test -n "$runpath_var" ||
test "X$hardcode_automatic" = "Xyes" ; then
# We can hardcode non-existent directories.
if test "$hardcode_direct" != no &&
# If the only mechanism to avoid hardcoding is shlibpath_var, we
# have to relink, otherwise we might link with an installed library
# when we should be linking with a yet-to-be-installed one
## test "$_LT_TAGVAR(hardcode_shlibpath_var, )" != no &&
test "$hardcode_minus_L" != no; then
# Linking always hardcodes the temporary library directory.
hardcode_action=relink
else
# We can link without hardcoding, and we can hardcode nonexisting dirs.
hardcode_action=immediate
fi
else
# We cannot hardcode anything, or else we can only hardcode existing
# directories.
hardcode_action=unsupported
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5
$as_echo "$hardcode_action" >&6; }
if test "$hardcode_action" = relink ||
test "$inherit_rpath" = yes; then
# Fast installation is not supported
enable_fast_install=no
elif test "$shlibpath_overrides_runpath" = yes ||
test "$enable_shared" = no; then
# Fast installation is not necessary
enable_fast_install=needless
fi
if test "x$enable_dlopen" != xyes; then
enable_dlopen=unknown
enable_dlopen_self=unknown
enable_dlopen_self_static=unknown
else
lt_cv_dlopen=no
lt_cv_dlopen_libs=
case $host_os in
beos*)
lt_cv_dlopen="load_add_on"
lt_cv_dlopen_libs=
lt_cv_dlopen_self=yes
;;
mingw* | pw32* | cegcc*)
lt_cv_dlopen="LoadLibrary"
lt_cv_dlopen_libs=
;;
cygwin*)
lt_cv_dlopen="dlopen"
lt_cv_dlopen_libs=
;;
darwin*)
# if libdl is installed we need to link against it
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
$as_echo_n "checking for dlopen in -ldl... " >&6; }
if ${ac_cv_lib_dl_dlopen+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldl $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char dlopen ();
int
main ()
{
return dlopen ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dl_dlopen=yes
else
ac_cv_lib_dl_dlopen=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
else
lt_cv_dlopen="dyld"
lt_cv_dlopen_libs=
lt_cv_dlopen_self=yes
fi
;;
*)
ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load"
if test "x$ac_cv_func_shl_load" = xyes; then :
lt_cv_dlopen="shl_load"
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
$as_echo_n "checking for shl_load in -ldld... " >&6; }
if ${ac_cv_lib_dld_shl_load+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldld $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char shl_load ();
int
main ()
{
return shl_load ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dld_shl_load=yes
else
ac_cv_lib_dld_shl_load=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
if test "x$ac_cv_lib_dld_shl_load" = xyes; then :
lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"
else
ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
if test "x$ac_cv_func_dlopen" = xyes; then :
lt_cv_dlopen="dlopen"
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
$as_echo_n "checking for dlopen in -ldl... " >&6; }
if ${ac_cv_lib_dl_dlopen+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldl $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char dlopen ();
int
main ()
{
return dlopen ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dl_dlopen=yes
else
ac_cv_lib_dl_dlopen=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5
$as_echo_n "checking for dlopen in -lsvld... " >&6; }
if ${ac_cv_lib_svld_dlopen+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lsvld $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char dlopen ();
int
main ()
{
return dlopen ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_svld_dlopen=yes
else
ac_cv_lib_svld_dlopen=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5
$as_echo "$ac_cv_lib_svld_dlopen" >&6; }
if test "x$ac_cv_lib_svld_dlopen" = xyes; then :
lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld"
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5
$as_echo_n "checking for dld_link in -ldld... " >&6; }
if ${ac_cv_lib_dld_dld_link+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldld $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char dld_link ();
int
main ()
{
return dld_link ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dld_dld_link=yes
else
ac_cv_lib_dld_dld_link=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5
$as_echo "$ac_cv_lib_dld_dld_link" >&6; }
if test "x$ac_cv_lib_dld_dld_link" = xyes; then :
lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"
fi
fi
fi
fi
fi
fi
;;
esac
if test "x$lt_cv_dlopen" != xno; then
enable_dlopen=yes
else
enable_dlopen=no
fi
case $lt_cv_dlopen in
dlopen)
save_CPPFLAGS="$CPPFLAGS"
test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
save_LDFLAGS="$LDFLAGS"
wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
save_LIBS="$LIBS"
LIBS="$lt_cv_dlopen_libs $LIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5
$as_echo_n "checking whether a program can dlopen itself... " >&6; }
if ${lt_cv_dlopen_self+:} false; then :
$as_echo_n "(cached) " >&6
else
if test "$cross_compiling" = yes; then :
lt_cv_dlopen_self=cross
else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line $LINENO "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
#include
#endif
#include
#ifdef RTLD_GLOBAL
# define LT_DLGLOBAL RTLD_GLOBAL
#else
# ifdef DL_GLOBAL
# define LT_DLGLOBAL DL_GLOBAL
# else
# define LT_DLGLOBAL 0
# endif
#endif
/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
find out it does not work in some platform. */
#ifndef LT_DLLAZY_OR_NOW
# ifdef RTLD_LAZY
# define LT_DLLAZY_OR_NOW RTLD_LAZY
# else
# ifdef DL_LAZY
# define LT_DLLAZY_OR_NOW DL_LAZY
# else
# ifdef RTLD_NOW
# define LT_DLLAZY_OR_NOW RTLD_NOW
# else
# ifdef DL_NOW
# define LT_DLLAZY_OR_NOW DL_NOW
# else
# define LT_DLLAZY_OR_NOW 0
# endif
# endif
# endif
# endif
#endif
/* When -fvisbility=hidden is used, assume the code has been annotated
correspondingly for the symbols needed. */
#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
int fnord () __attribute__((visibility("default")));
#endif
int fnord () { return 42; }
int main ()
{
void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
int status = $lt_dlunknown;
if (self)
{
if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
else
{
if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
else puts (dlerror ());
}
/* dlclose (self); */
}
else
puts (dlerror ());
return status;
}
_LT_EOF
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
(eval $ac_link) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then
(./conftest; exit; ) >&5 2>/dev/null
lt_status=$?
case x$lt_status in
x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;;
x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;;
x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;;
esac
else :
# compilation failed
lt_cv_dlopen_self=no
fi
fi
rm -fr conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5
$as_echo "$lt_cv_dlopen_self" >&6; }
if test "x$lt_cv_dlopen_self" = xyes; then
wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5
$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; }
if ${lt_cv_dlopen_self_static+:} false; then :
$as_echo_n "(cached) " >&6
else
if test "$cross_compiling" = yes; then :
lt_cv_dlopen_self_static=cross
else
lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
lt_status=$lt_dlunknown
cat > conftest.$ac_ext <<_LT_EOF
#line $LINENO "configure"
#include "confdefs.h"
#if HAVE_DLFCN_H
#include
#endif
#include
#ifdef RTLD_GLOBAL
# define LT_DLGLOBAL RTLD_GLOBAL
#else
# ifdef DL_GLOBAL
# define LT_DLGLOBAL DL_GLOBAL
# else
# define LT_DLGLOBAL 0
# endif
#endif
/* We may have to define LT_DLLAZY_OR_NOW in the command line if we
find out it does not work in some platform. */
#ifndef LT_DLLAZY_OR_NOW
# ifdef RTLD_LAZY
# define LT_DLLAZY_OR_NOW RTLD_LAZY
# else
# ifdef DL_LAZY
# define LT_DLLAZY_OR_NOW DL_LAZY
# else
# ifdef RTLD_NOW
# define LT_DLLAZY_OR_NOW RTLD_NOW
# else
# ifdef DL_NOW
# define LT_DLLAZY_OR_NOW DL_NOW
# else
# define LT_DLLAZY_OR_NOW 0
# endif
# endif
# endif
# endif
#endif
/* When -fvisbility=hidden is used, assume the code has been annotated
correspondingly for the symbols needed. */
#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3))
int fnord () __attribute__((visibility("default")));
#endif
int fnord () { return 42; }
int main ()
{
void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW);
int status = $lt_dlunknown;
if (self)
{
if (dlsym (self,"fnord")) status = $lt_dlno_uscore;
else
{
if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore;
else puts (dlerror ());
}
/* dlclose (self); */
}
else
puts (dlerror ());
return status;
}
_LT_EOF
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5
(eval $ac_link) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then
(./conftest; exit; ) >&5 2>/dev/null
lt_status=$?
case x$lt_status in
x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;;
x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;;
x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;;
esac
else :
# compilation failed
lt_cv_dlopen_self_static=no
fi
fi
rm -fr conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5
$as_echo "$lt_cv_dlopen_self_static" >&6; }
fi
CPPFLAGS="$save_CPPFLAGS"
LDFLAGS="$save_LDFLAGS"
LIBS="$save_LIBS"
;;
esac
case $lt_cv_dlopen_self in
yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
*) enable_dlopen_self=unknown ;;
esac
case $lt_cv_dlopen_self_static in
yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
*) enable_dlopen_self_static=unknown ;;
esac
fi
striplib=
old_striplib=
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5
$as_echo_n "checking whether stripping libraries is possible... " >&6; }
if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then
test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
test -z "$striplib" && striplib="$STRIP --strip-unneeded"
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
# FIXME - insert some real tests, host_os isn't really good enough
case $host_os in
darwin*)
if test -n "$STRIP" ; then
striplib="$STRIP -x"
old_striplib="$STRIP -S"
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
;;
*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
;;
esac
fi
# Report which library types will actually be built
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5
$as_echo_n "checking if libtool supports shared libraries... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5
$as_echo "$can_build_shared" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5
$as_echo_n "checking whether to build shared libraries... " >&6; }
test "$can_build_shared" = "no" && enable_shared=no
# On AIX, shared libraries and static libraries use the same namespace, and
# are all built from PIC.
case $host_os in
aix3*)
test "$enable_shared" = yes && enable_static=no
if test -n "$RANLIB"; then
archive_cmds="$archive_cmds~\$RANLIB \$lib"
postinstall_cmds='$RANLIB $lib'
fi
;;
aix[4-9]*)
if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
test "$enable_shared" = yes && enable_static=no
fi
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5
$as_echo "$enable_shared" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5
$as_echo_n "checking whether to build static libraries... " >&6; }
# Make sure either enable_shared or enable_static is yes.
test "$enable_shared" = yes || enable_static=yes
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5
$as_echo "$enable_static" >&6; }
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
CC="$lt_save_CC"
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
if test -z "$F77" || test "X$F77" = "Xno"; then
_lt_disable_F77=yes
fi
archive_cmds_need_lc_F77=no
allow_undefined_flag_F77=
always_export_symbols_F77=no
archive_expsym_cmds_F77=
export_dynamic_flag_spec_F77=
hardcode_direct_F77=no
hardcode_direct_absolute_F77=no
hardcode_libdir_flag_spec_F77=
hardcode_libdir_separator_F77=
hardcode_minus_L_F77=no
hardcode_automatic_F77=no
inherit_rpath_F77=no
module_cmds_F77=
module_expsym_cmds_F77=
link_all_deplibs_F77=unknown
old_archive_cmds_F77=$old_archive_cmds
reload_flag_F77=$reload_flag
reload_cmds_F77=$reload_cmds
no_undefined_flag_F77=
whole_archive_flag_spec_F77=
enable_shared_with_static_runtimes_F77=no
# Source file extension for f77 test sources.
ac_ext=f
# Object file extension for compiled f77 test sources.
objext=o
objext_F77=$objext
# No sense in running all these tests if we already determined that
# the F77 compiler isn't working. Some variables (like enable_shared)
# are currently assumed to apply to all compilers on this platform,
# and will be corrupted by setting them based on a non-working compiler.
if test "$_lt_disable_F77" != yes; then
# Code to be used in simple compile tests
lt_simple_compile_test_code="\
subroutine t
return
end
"
# Code to be used in simple link tests
lt_simple_link_test_code="\
program t
end
"
# ltmain only uses $CC for tagged configurations so make sure $CC is set.
# If no C compiler was specified, use CC.
LTCC=${LTCC-"$CC"}
# If no C compiler flags were specified, use CFLAGS.
LTCFLAGS=${LTCFLAGS-"$CFLAGS"}
# Allow CC to be a program name with arguments.
compiler=$CC
# save warnings/boilerplate of simple test code
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" >conftest.$ac_ext
eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_compiler_boilerplate=`cat conftest.err`
$RM conftest*
ac_outfile=conftest.$ac_objext
echo "$lt_simple_link_test_code" >conftest.$ac_ext
eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err
_lt_linker_boilerplate=`cat conftest.err`
$RM -r conftest*
# Allow CC to be a program name with arguments.
lt_save_CC="$CC"
lt_save_GCC=$GCC
lt_save_CFLAGS=$CFLAGS
CC=${F77-"f77"}
CFLAGS=$FFLAGS
compiler=$CC
compiler_F77=$CC
for cc_temp in $compiler""; do
case $cc_temp in
compile | *[\\/]compile | ccache | *[\\/]ccache ) ;;
distcc | *[\\/]distcc | purify | *[\\/]purify ) ;;
\-*) ;;
*) break;;
esac
done
cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"`
GCC=$G77
if test -n "$compiler"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5
$as_echo_n "checking if libtool supports shared libraries... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5
$as_echo "$can_build_shared" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5
$as_echo_n "checking whether to build shared libraries... " >&6; }
test "$can_build_shared" = "no" && enable_shared=no
# On AIX, shared libraries and static libraries use the same namespace, and
# are all built from PIC.
case $host_os in
aix3*)
test "$enable_shared" = yes && enable_static=no
if test -n "$RANLIB"; then
archive_cmds="$archive_cmds~\$RANLIB \$lib"
postinstall_cmds='$RANLIB $lib'
fi
;;
aix[4-9]*)
if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then
test "$enable_shared" = yes && enable_static=no
fi
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5
$as_echo "$enable_shared" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5
$as_echo_n "checking whether to build static libraries... " >&6; }
# Make sure either enable_shared or enable_static is yes.
test "$enable_shared" = yes || enable_static=yes
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5
$as_echo "$enable_static" >&6; }
GCC_F77="$G77"
LD_F77="$LD"
## CAVEAT EMPTOR:
## There is no encapsulation within the following macros, do not change
## the running order or otherwise move them around unless you know exactly
## what you are doing...
lt_prog_compiler_wl_F77=
lt_prog_compiler_pic_F77=
lt_prog_compiler_static_F77=
if test "$GCC" = yes; then
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_static_F77='-static'
case $host_os in
aix*)
# All AIX code is PIC.
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
lt_prog_compiler_static_F77='-Bstatic'
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
lt_prog_compiler_pic_F77='-fPIC'
;;
m68k)
# FIXME: we need at least 68020 code to build shared libraries, but
# adding the `-m68020' flag to GCC prevents building anything better,
# like `-m68040'.
lt_prog_compiler_pic_F77='-m68020 -resident32 -malways-restore-a4'
;;
esac
;;
beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*)
# PIC is the default for these OSes.
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
# Although the cygwin gcc ignores -fPIC, still need this for old-style
# (--disable-auto-import) libraries
lt_prog_compiler_pic_F77='-DDLL_EXPORT'
;;
darwin* | rhapsody*)
# PIC is the default on this platform
# Common symbols not allowed in MH_DYLIB files
lt_prog_compiler_pic_F77='-fno-common'
;;
haiku*)
# PIC is the default for Haiku.
# The "-static" flag exists, but is broken.
lt_prog_compiler_static_F77=
;;
hpux*)
# PIC is the default for 64-bit PA HP-UX, but not for 32-bit
# PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag
# sets the default TLS model and affects inlining.
case $host_cpu in
hppa*64*)
# +Z the default
;;
*)
lt_prog_compiler_pic_F77='-fPIC'
;;
esac
;;
interix[3-9]*)
# Interix 3.x gcc -fpic/-fPIC options generate broken code.
# Instead, we relocate shared libraries at runtime.
;;
msdosdjgpp*)
# Just because we use GCC doesn't mean we suddenly get shared libraries
# on systems that don't support them.
lt_prog_compiler_can_build_shared_F77=no
enable_shared=no
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
lt_prog_compiler_pic_F77='-fPIC -shared'
;;
sysv4*MP*)
if test -d /usr/nec; then
lt_prog_compiler_pic_F77=-Kconform_pic
fi
;;
*)
lt_prog_compiler_pic_F77='-fPIC'
;;
esac
case $cc_basename in
nvcc*) # Cuda Compiler Driver 2.2
lt_prog_compiler_wl_F77='-Xlinker '
if test -n "$lt_prog_compiler_pic_F77"; then
lt_prog_compiler_pic_F77="-Xcompiler $lt_prog_compiler_pic_F77"
fi
;;
esac
else
# PORTME Check for flag to pass linker flags through the system compiler.
case $host_os in
aix*)
lt_prog_compiler_wl_F77='-Wl,'
if test "$host_cpu" = ia64; then
# AIX 5 now supports IA64 processor
lt_prog_compiler_static_F77='-Bstatic'
else
lt_prog_compiler_static_F77='-bnso -bI:/lib/syscalls.exp'
fi
;;
mingw* | cygwin* | pw32* | os2* | cegcc*)
# This hack is so that the source file can tell whether it is being
# built for inclusion in a dll (and should export symbols for example).
lt_prog_compiler_pic_F77='-DDLL_EXPORT'
;;
hpux9* | hpux10* | hpux11*)
lt_prog_compiler_wl_F77='-Wl,'
# PIC is the default for IA64 HP-UX and 64-bit HP-UX, but
# not for PA HP-UX.
case $host_cpu in
hppa*64*|ia64*)
# +Z the default
;;
*)
lt_prog_compiler_pic_F77='+Z'
;;
esac
# Is there a better lt_prog_compiler_static that works with the bundled CC?
lt_prog_compiler_static_F77='${wl}-a ${wl}archive'
;;
irix5* | irix6* | nonstopux*)
lt_prog_compiler_wl_F77='-Wl,'
# PIC (with -KPIC) is the default.
lt_prog_compiler_static_F77='-non_shared'
;;
linux* | k*bsd*-gnu | kopensolaris*-gnu)
case $cc_basename in
# old Intel for x86_64 which still supported -KPIC.
ecc*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-static'
;;
# icc used to be incompatible with GCC.
# ICC 10 doesn't accept -KPIC any more.
icc* | ifort*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-fPIC'
lt_prog_compiler_static_F77='-static'
;;
# Lahey Fortran 8.1.
lf95*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='--shared'
lt_prog_compiler_static_F77='--static'
;;
nagfor*)
# NAG Fortran compiler
lt_prog_compiler_wl_F77='-Wl,-Wl,,'
lt_prog_compiler_pic_F77='-PIC'
lt_prog_compiler_static_F77='-Bstatic'
;;
pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group compilers (*not* the Pentium gcc compiler,
# which looks to be a dead project)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-fpic'
lt_prog_compiler_static_F77='-Bstatic'
;;
ccc*)
lt_prog_compiler_wl_F77='-Wl,'
# All Alpha code is PIC.
lt_prog_compiler_static_F77='-non_shared'
;;
xl* | bgxl* | bgf* | mpixl*)
# IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-qpic'
lt_prog_compiler_static_F77='-qstaticlink'
;;
*)
case `$CC -V 2>&1 | sed 5q` in
*Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*)
# Sun Fortran 8.3 passes all unrecognized flags to the linker
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
lt_prog_compiler_wl_F77=''
;;
*Sun\ F* | *Sun*Fortran*)
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
lt_prog_compiler_wl_F77='-Qoption ld '
;;
*Sun\ C*)
# Sun C 5.9
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
lt_prog_compiler_wl_F77='-Wl,'
;;
*Intel*\ [CF]*Compiler*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-fPIC'
lt_prog_compiler_static_F77='-static'
;;
*Portland\ Group*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-fpic'
lt_prog_compiler_static_F77='-Bstatic'
;;
esac
;;
esac
;;
newsos6)
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
;;
*nto* | *qnx*)
# QNX uses GNU C++, but need to define -shared option too, otherwise
# it will coredump.
lt_prog_compiler_pic_F77='-fPIC -shared'
;;
osf3* | osf4* | osf5*)
lt_prog_compiler_wl_F77='-Wl,'
# All OSF/1 code is PIC.
lt_prog_compiler_static_F77='-non_shared'
;;
rdos*)
lt_prog_compiler_static_F77='-non_shared'
;;
solaris*)
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
case $cc_basename in
f77* | f90* | f95* | sunf77* | sunf90* | sunf95*)
lt_prog_compiler_wl_F77='-Qoption ld ';;
*)
lt_prog_compiler_wl_F77='-Wl,';;
esac
;;
sunos4*)
lt_prog_compiler_wl_F77='-Qoption ld '
lt_prog_compiler_pic_F77='-PIC'
lt_prog_compiler_static_F77='-Bstatic'
;;
sysv4 | sysv4.2uw2* | sysv4.3*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
;;
sysv4*MP*)
if test -d /usr/nec ;then
lt_prog_compiler_pic_F77='-Kconform_pic'
lt_prog_compiler_static_F77='-Bstatic'
fi
;;
sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_pic_F77='-KPIC'
lt_prog_compiler_static_F77='-Bstatic'
;;
unicos*)
lt_prog_compiler_wl_F77='-Wl,'
lt_prog_compiler_can_build_shared_F77=no
;;
uts4*)
lt_prog_compiler_pic_F77='-pic'
lt_prog_compiler_static_F77='-Bstatic'
;;
*)
lt_prog_compiler_can_build_shared_F77=no
;;
esac
fi
case $host_os in
# For platforms which do not support PIC, -DPIC is meaningless:
*djgpp*)
lt_prog_compiler_pic_F77=
;;
*)
lt_prog_compiler_pic_F77="$lt_prog_compiler_pic_F77"
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5
$as_echo_n "checking for $compiler option to produce PIC... " >&6; }
if ${lt_cv_prog_compiler_pic_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_pic_F77=$lt_prog_compiler_pic_F77
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_F77" >&5
$as_echo "$lt_cv_prog_compiler_pic_F77" >&6; }
lt_prog_compiler_pic_F77=$lt_cv_prog_compiler_pic_F77
#
# Check to make sure the PIC flag actually works.
#
if test -n "$lt_prog_compiler_pic_F77"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works" >&5
$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic_F77 works... " >&6; }
if ${lt_cv_prog_compiler_pic_works_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_pic_works_F77=no
ac_outfile=conftest.$ac_objext
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="$lt_prog_compiler_pic_F77"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
# The option is referenced via a variable to avoid confusing sed.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>conftest.err)
ac_status=$?
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s "$ac_outfile"; then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings other than the usual output.
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler_pic_works_F77=yes
fi
fi
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works_F77" >&5
$as_echo "$lt_cv_prog_compiler_pic_works_F77" >&6; }
if test x"$lt_cv_prog_compiler_pic_works_F77" = xyes; then
case $lt_prog_compiler_pic_F77 in
"" | " "*) ;;
*) lt_prog_compiler_pic_F77=" $lt_prog_compiler_pic_F77" ;;
esac
else
lt_prog_compiler_pic_F77=
lt_prog_compiler_can_build_shared_F77=no
fi
fi
#
# Check to make sure the static flag actually works.
#
wl=$lt_prog_compiler_wl_F77 eval lt_tmp_static_flag=\"$lt_prog_compiler_static_F77\"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5
$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; }
if ${lt_cv_prog_compiler_static_works_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_static_works_F77=no
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS $lt_tmp_static_flag"
echo "$lt_simple_link_test_code" > conftest.$ac_ext
if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then
# The linker can only warn and ignore the option if not recognized
# So say no if there are warnings
if test -s conftest.err; then
# Append any errors to the config.log.
cat conftest.err 1>&5
$ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp
$SED '/^$/d; /^ *+/d' conftest.err >conftest.er2
if diff conftest.exp conftest.er2 >/dev/null; then
lt_cv_prog_compiler_static_works_F77=yes
fi
else
lt_cv_prog_compiler_static_works_F77=yes
fi
fi
$RM -r conftest*
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works_F77" >&5
$as_echo "$lt_cv_prog_compiler_static_works_F77" >&6; }
if test x"$lt_cv_prog_compiler_static_works_F77" = xyes; then
:
else
lt_prog_compiler_static_F77=
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
if ${lt_cv_prog_compiler_c_o_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_c_o_F77=no
$RM -r conftest 2>/dev/null
mkdir conftest
cd conftest
mkdir out
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-o out/conftest2.$ac_objext"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
$SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
lt_cv_prog_compiler_c_o_F77=yes
fi
fi
chmod u+w . 2>&5
$RM conftest*
# SGI C++ compiler will create directory out/ii_files/ for
# template instantiation
test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
$RM out/* && rmdir out
cd ..
$RM -r conftest
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5
$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5
$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; }
if ${lt_cv_prog_compiler_c_o_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_prog_compiler_c_o_F77=no
$RM -r conftest 2>/dev/null
mkdir conftest
cd conftest
mkdir out
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
lt_compiler_flag="-o out/conftest2.$ac_objext"
# Insert the option either (1) after the last *FLAGS variable, or
# (2) before a word containing "conftest.", or (3) at the end.
# Note that $ac_compile itself does not contain backslashes and begins
# with a dollar sign (not a hyphen), so the echo should work correctly.
lt_compile=`echo "$ac_compile" | $SED \
-e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
-e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
-e 's:$: $lt_compiler_flag:'`
(eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5)
(eval "$lt_compile" 2>out/conftest.err)
ac_status=$?
cat out/conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
if (exit $ac_status) && test -s out/conftest2.$ac_objext
then
# The compiler can only warn and ignore the option if not recognized
# So say no if there are warnings
$ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp
$SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2
if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then
lt_cv_prog_compiler_c_o_F77=yes
fi
fi
chmod u+w . 2>&5
$RM conftest*
# SGI C++ compiler will create directory out/ii_files/ for
# template instantiation
test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files
$RM out/* && rmdir out
cd ..
$RM -r conftest
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o_F77" >&5
$as_echo "$lt_cv_prog_compiler_c_o_F77" >&6; }
hard_links="nottested"
if test "$lt_cv_prog_compiler_c_o_F77" = no && test "$need_locks" != no; then
# do not overwrite the value of need_locks provided by the user
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5
$as_echo_n "checking if we can lock with hard links... " >&6; }
hard_links=yes
$RM conftest*
ln conftest.a conftest.b 2>/dev/null && hard_links=no
touch conftest.a
ln conftest.a conftest.b 2>&5 || hard_links=no
ln conftest.a conftest.b 2>/dev/null && hard_links=no
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5
$as_echo "$hard_links" >&6; }
if test "$hard_links" = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5
$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;}
need_locks=warn
fi
else
need_locks=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5
$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; }
runpath_var=
allow_undefined_flag_F77=
always_export_symbols_F77=no
archive_cmds_F77=
archive_expsym_cmds_F77=
compiler_needs_object_F77=no
enable_shared_with_static_runtimes_F77=no
export_dynamic_flag_spec_F77=
export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols'
hardcode_automatic_F77=no
hardcode_direct_F77=no
hardcode_direct_absolute_F77=no
hardcode_libdir_flag_spec_F77=
hardcode_libdir_separator_F77=
hardcode_minus_L_F77=no
hardcode_shlibpath_var_F77=unsupported
inherit_rpath_F77=no
link_all_deplibs_F77=unknown
module_cmds_F77=
module_expsym_cmds_F77=
old_archive_from_new_cmds_F77=
old_archive_from_expsyms_cmds_F77=
thread_safe_flag_spec_F77=
whole_archive_flag_spec_F77=
# include_expsyms should be a list of space-separated symbols to be *always*
# included in the symbol list
include_expsyms_F77=
# exclude_expsyms can be an extended regexp of symbols to exclude
# it will be wrapped by ` (' and `)$', so one must not match beginning or
# end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
# as well as any symbol that contains `d'.
exclude_expsyms_F77='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'
# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
# platforms (ab)use it in PIC code, but their linkers get confused if
# the symbol is explicitly referenced. Since portable code cannot
# rely on this symbol name, it's probably fine to never include it in
# preloaded symbol tables.
# Exclude shared library initialization/finalization symbols.
extract_expsyms_cmds=
case $host_os in
cygwin* | mingw* | pw32* | cegcc*)
# FIXME: the MSVC++ port hasn't been tested in a loooong time
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
if test "$GCC" != yes; then
with_gnu_ld=no
fi
;;
interix*)
# we just hope/assume this is gcc and not c89 (= MSVC++)
with_gnu_ld=yes
;;
openbsd*)
with_gnu_ld=no
;;
esac
ld_shlibs_F77=yes
# On some targets, GNU ld is compatible enough with the native linker
# that we're better off using the native interface for both.
lt_use_gnu_ld_interface=no
if test "$with_gnu_ld" = yes; then
case $host_os in
aix*)
# The AIX port of GNU ld has always aspired to compatibility
# with the native linker. However, as the warning in the GNU ld
# block says, versions before 2.19.5* couldn't really create working
# shared libraries, regardless of the interface used.
case `$LD -v 2>&1` in
*\ \(GNU\ Binutils\)\ 2.19.5*) ;;
*\ \(GNU\ Binutils\)\ 2.[2-9]*) ;;
*\ \(GNU\ Binutils\)\ [3-9]*) ;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
;;
*)
lt_use_gnu_ld_interface=yes
;;
esac
fi
if test "$lt_use_gnu_ld_interface" = yes; then
# If archive_cmds runs LD, not CC, wlarc should be empty
wlarc='${wl}'
# Set some defaults for GNU ld with shared library support. These
# are reset later if shared libraries are not supported. Putting them
# here allows them to be overridden if necessary.
runpath_var=LD_RUN_PATH
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
export_dynamic_flag_spec_F77='${wl}--export-dynamic'
# ancient GNU ld didn't support --whole-archive et. al.
if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then
whole_archive_flag_spec_F77="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
else
whole_archive_flag_spec_F77=
fi
supports_anon_versioning=no
case `$LD -v 2>&1` in
*GNU\ gold*) supports_anon_versioning=yes ;;
*\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11
*\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ...
*\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ...
*\ 2.11.*) ;; # other 2.11 versions
*) supports_anon_versioning=yes ;;
esac
# See if GNU ld supports shared libraries.
case $host_os in
aix[3-9]*)
# On AIX/PPC, the GNU linker is very broken
if test "$host_cpu" != ia64; then
ld_shlibs_F77=no
cat <<_LT_EOF 1>&2
*** Warning: the GNU linker, at least up to release 2.19, is reported
*** to be unable to reliably create shared libraries on AIX.
*** Therefore, libtool is disabling shared libraries support. If you
*** really care for shared libraries, you may want to install binutils
*** 2.20 or above, or modify your PATH so that a non-GNU linker is found.
*** You will then need to restart the configuration process.
_LT_EOF
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77=''
;;
m68k)
archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_minus_L_F77=yes
;;
esac
;;
beos*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
allow_undefined_flag_F77=unsupported
# Joseph Beckenbach says some releases of gcc
# support --undefined. This deserves some investigation. FIXME
archive_cmds_F77='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
else
ld_shlibs_F77=no
fi
;;
cygwin* | mingw* | pw32* | cegcc*)
# _LT_TAGVAR(hardcode_libdir_flag_spec, F77) is actually meaningless,
# as there is no search path for DLLs.
hardcode_libdir_flag_spec_F77='-L$libdir'
export_dynamic_flag_spec_F77='${wl}--export-all-symbols'
allow_undefined_flag_F77=unsupported
always_export_symbols_F77=no
enable_shared_with_static_runtimes_F77=yes
export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols'
exclude_expsyms_F77='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname'
if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
# If the export-symbols file already is a .def file (1st line
# is EXPORTS), use it as is; otherwise, prepend...
archive_expsym_cmds_F77='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
cp $export_symbols $output_objdir/$soname.def;
else
echo EXPORTS > $output_objdir/$soname.def;
cat $export_symbols >> $output_objdir/$soname.def;
fi~
$CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib'
else
ld_shlibs_F77=no
fi
;;
haiku*)
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
link_all_deplibs_F77=yes
;;
interix[3-9]*)
hardcode_direct_F77=no
hardcode_shlibpath_var_F77=no
hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir'
export_dynamic_flag_spec_F77='${wl}-E'
# Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc.
# Instead, shared libraries are loaded at an image base (0x10000000 by
# default) and relocated if they conflict, which is a slow very memory
# consuming and fragmenting process. To avoid this, we pick a random,
# 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link
# time. Moving up from 0x10000000 also allows more sbrk(2) space.
archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
archive_expsym_cmds_F77='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib'
;;
gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu)
tmp_diet=no
if test "$host_os" = linux-dietlibc; then
case $cc_basename in
diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn)
esac
fi
if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \
&& test "$tmp_diet" = no
then
tmp_addflag=' $pic_flag'
tmp_sharedflag='-shared'
case $cc_basename,$host_cpu in
pgcc*) # Portland Group C compiler
whole_archive_flag_spec_F77='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag'
;;
pgf77* | pgf90* | pgf95* | pgfortran*)
# Portland Group f77 and f90 compilers
whole_archive_flag_spec_F77='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
tmp_addflag=' $pic_flag -Mnomain' ;;
ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64
tmp_addflag=' -i_dynamic' ;;
efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64
tmp_addflag=' -i_dynamic -nofor_main' ;;
ifc* | ifort*) # Intel Fortran compiler
tmp_addflag=' -nofor_main' ;;
lf95*) # Lahey Fortran 8.1
whole_archive_flag_spec_F77=
tmp_sharedflag='--shared' ;;
xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below)
tmp_sharedflag='-qmkshrobj'
tmp_addflag= ;;
nvcc*) # Cuda Compiler Driver 2.2
whole_archive_flag_spec_F77='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
compiler_needs_object_F77=yes
;;
esac
case `$CC -V 2>&1 | sed 5q` in
*Sun\ C*) # Sun C 5.9
whole_archive_flag_spec_F77='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive'
compiler_needs_object_F77=yes
tmp_sharedflag='-G' ;;
*Sun\ F*) # Sun Fortran 8.3
tmp_sharedflag='-G' ;;
esac
archive_cmds_F77='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib'
fi
case $cc_basename in
xlf* | bgf* | bgxlf* | mpixlf*)
# IBM XL Fortran 10.1 on PPC cannot create shared libs itself
whole_archive_flag_spec_F77='--whole-archive$convenience --no-whole-archive'
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
archive_cmds_F77='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib'
if test "x$supports_anon_versioning" = xyes; then
archive_expsym_cmds_F77='echo "{ global:" > $output_objdir/$libname.ver~
cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~
echo "local: *; };" >> $output_objdir/$libname.ver~
$LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib'
fi
;;
esac
else
ld_shlibs_F77=no
fi
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
archive_cmds_F77='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
wlarc=
else
archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
fi
;;
solaris*)
if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then
ld_shlibs_F77=no
cat <<_LT_EOF 1>&2
*** Warning: The releases 2.8.* of the GNU linker cannot reliably
*** create shared libraries on Solaris systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.9.1 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs_F77=no
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*)
case `$LD -v 2>&1` in
*\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*)
ld_shlibs_F77=no
cat <<_LT_EOF 1>&2
*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not
*** reliably create shared libraries on SCO systems. Therefore, libtool
*** is disabling shared libraries support. We urge you to upgrade GNU
*** binutils to release 2.16.91.0.3 or newer. Another option is to modify
*** your PATH or compiler configuration so that the native linker is
*** used, and then restart.
_LT_EOF
;;
*)
# For security reasons, it is highly recommended that you always
# use absolute paths for naming shared libraries, and exclude the
# DT_RUNPATH tag from executables and libraries. But doing so
# requires that you compile everything twice, which is a pain.
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs_F77=no
fi
;;
esac
;;
sunos4*)
archive_cmds_F77='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
wlarc=
hardcode_direct_F77=yes
hardcode_shlibpath_var_F77=no
;;
*)
if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then
archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
else
ld_shlibs_F77=no
fi
;;
esac
if test "$ld_shlibs_F77" = no; then
runpath_var=
hardcode_libdir_flag_spec_F77=
export_dynamic_flag_spec_F77=
whole_archive_flag_spec_F77=
fi
else
# PORTME fill in a description of your system's linker (not GNU ld)
case $host_os in
aix3*)
allow_undefined_flag_F77=unsupported
always_export_symbols_F77=yes
archive_expsym_cmds_F77='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname'
# Note: this linker hardcodes the directories in LIBPATH if there
# are no directories specified by -L.
hardcode_minus_L_F77=yes
if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then
# Neither direct hardcoding nor static linking is supported with a
# broken collect2.
hardcode_direct_F77=unsupported
fi
;;
aix[4-9]*)
if test "$host_cpu" = ia64; then
# On IA64, the linker does run time linking by default, so we don't
# have to do anything special.
aix_use_runtimelinking=no
exp_sym_flag='-Bexport'
no_entry_flag=""
else
# If we're using GNU nm, then we don't want the "-C" option.
# -C means demangle to AIX nm, but means don't demangle with GNU nm
# Also, AIX nm treats weak defined symbols like other global
# defined symbols, whereas GNU nm marks them as "W".
if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then
export_symbols_cmds_F77='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
else
export_symbols_cmds_F77='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols'
fi
aix_use_runtimelinking=no
# Test if we are trying to use run time linking or normal
# AIX style linking. If -brtl is somewhere in LDFLAGS, we
# need to do runtime linking.
case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*)
for ld_flag in $LDFLAGS; do
if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then
aix_use_runtimelinking=yes
break
fi
done
;;
esac
exp_sym_flag='-bexport'
no_entry_flag='-bnoentry'
fi
# When large executables or shared objects are built, AIX ld can
# have problems creating the table of contents. If linking a library
# or program results in "error TOC overflow" add -mminimal-toc to
# CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not
# enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS.
archive_cmds_F77=''
hardcode_direct_F77=yes
hardcode_direct_absolute_F77=yes
hardcode_libdir_separator_F77=':'
link_all_deplibs_F77=yes
file_list_spec_F77='${wl}-f,'
if test "$GCC" = yes; then
case $host_os in aix4.[012]|aix4.[012].*)
# We only want to do this on AIX 4.2 and lower, the check
# below for broken collect2 doesn't work under 4.3+
collect2name=`${CC} -print-prog-name=collect2`
if test -f "$collect2name" &&
strings "$collect2name" | $GREP resolve_lib_name >/dev/null
then
# We have reworked collect2
:
else
# We have old collect2
hardcode_direct_F77=unsupported
# It fails to find uninstalled libraries when the uninstalled
# path is not listed in the libpath. Setting hardcode_minus_L
# to unsupported forces relinking
hardcode_minus_L_F77=yes
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_libdir_separator_F77=
fi
;;
esac
shared_flag='-shared'
if test "$aix_use_runtimelinking" = yes; then
shared_flag="$shared_flag "'${wl}-G'
fi
else
# not using gcc
if test "$host_cpu" = ia64; then
# VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release
# chokes on -Wl,-G. The following line is correct:
shared_flag='-G'
else
if test "$aix_use_runtimelinking" = yes; then
shared_flag='${wl}-G'
else
shared_flag='${wl}-bM:SRE'
fi
fi
fi
export_dynamic_flag_spec_F77='${wl}-bexpall'
# It seems that -bexpall does not export symbols beginning with
# underscore (_), so it is better to generate a list of symbols to export.
always_export_symbols_F77=yes
if test "$aix_use_runtimelinking" = yes; then
# Warning - without using the other runtime loading flags (-brtl),
# -berok will link without error, but may produce a broken library.
allow_undefined_flag_F77='-berok'
# Determine the default libpath from the value encoded in an
# empty executable.
if test "${lt_cv_aix_libpath+set}" = set; then
aix_libpath=$lt_cv_aix_libpath
else
if ${lt_cv_aix_libpath__F77+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
lt_aix_libpath_sed='
/Import File Strings/,/^$/ {
/^0/ {
s/^0 *\([^ ]*\) *$/\1/
p
}
}'
lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
# Check for a 64-bit object if we didn't find anything.
if test -z "$lt_cv_aix_libpath__F77"; then
lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
if test -z "$lt_cv_aix_libpath__F77"; then
lt_cv_aix_libpath__F77="/usr/lib:/lib"
fi
fi
aix_libpath=$lt_cv_aix_libpath__F77
fi
hardcode_libdir_flag_spec_F77='${wl}-blibpath:$libdir:'"$aix_libpath"
archive_expsym_cmds_F77='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag"
else
if test "$host_cpu" = ia64; then
hardcode_libdir_flag_spec_F77='${wl}-R $libdir:/usr/lib:/lib'
allow_undefined_flag_F77="-z nodefs"
archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols"
else
# Determine the default libpath from the value encoded in an
# empty executable.
if test "${lt_cv_aix_libpath+set}" = set; then
aix_libpath=$lt_cv_aix_libpath
else
if ${lt_cv_aix_libpath__F77+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
lt_aix_libpath_sed='
/Import File Strings/,/^$/ {
/^0/ {
s/^0 *\([^ ]*\) *$/\1/
p
}
}'
lt_cv_aix_libpath__F77=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
# Check for a 64-bit object if we didn't find anything.
if test -z "$lt_cv_aix_libpath__F77"; then
lt_cv_aix_libpath__F77=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"`
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
if test -z "$lt_cv_aix_libpath__F77"; then
lt_cv_aix_libpath__F77="/usr/lib:/lib"
fi
fi
aix_libpath=$lt_cv_aix_libpath__F77
fi
hardcode_libdir_flag_spec_F77='${wl}-blibpath:$libdir:'"$aix_libpath"
# Warning - without using the other run time loading flags,
# -berok will link without error, but may produce a broken library.
no_undefined_flag_F77=' ${wl}-bernotok'
allow_undefined_flag_F77=' ${wl}-berok'
if test "$with_gnu_ld" = yes; then
# We only use this code for GNU lds that support --whole-archive.
whole_archive_flag_spec_F77='${wl}--whole-archive$convenience ${wl}--no-whole-archive'
else
# Exported symbols can be pulled into shared objects from archives
whole_archive_flag_spec_F77='$convenience'
fi
archive_cmds_need_lc_F77=yes
# This is similar to how AIX traditionally builds its shared libraries.
archive_expsym_cmds_F77="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname'
fi
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# see comment about AmigaOS4 .so support
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
archive_expsym_cmds_F77=''
;;
m68k)
archive_cmds_F77='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_minus_L_F77=yes
;;
esac
;;
bsdi[45]*)
export_dynamic_flag_spec_F77=-rdynamic
;;
cygwin* | mingw* | pw32* | cegcc*)
# When not using gcc, we currently assume that we are using
# Microsoft Visual C++.
# hardcode_libdir_flag_spec is actually meaningless, as there is
# no search path for DLLs.
case $cc_basename in
cl*)
# Native MSVC
hardcode_libdir_flag_spec_F77=' '
allow_undefined_flag_F77=unsupported
always_export_symbols_F77=yes
file_list_spec_F77='@'
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
archive_cmds_F77='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-dll~linknames='
archive_expsym_cmds_F77='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then
sed -n -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' -e '1\\\!p' < $export_symbols > $output_objdir/$soname.exp;
else
sed -e 's/\\\\\\\(.*\\\\\\\)/-link\\\ -EXPORT:\\\\\\\1/' < $export_symbols > $output_objdir/$soname.exp;
fi~
$CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~
linknames='
# The linker will not automatically build a static lib if we build a DLL.
# _LT_TAGVAR(old_archive_from_new_cmds, F77)='true'
enable_shared_with_static_runtimes_F77=yes
exclude_expsyms_F77='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*'
export_symbols_cmds_F77='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols'
# Don't use ranlib
old_postinstall_cmds_F77='chmod 644 $oldlib'
postlink_cmds_F77='lt_outputfile="@OUTPUT@"~
lt_tool_outputfile="@TOOL_OUTPUT@"~
case $lt_outputfile in
*.exe|*.EXE) ;;
*)
lt_outputfile="$lt_outputfile.exe"
lt_tool_outputfile="$lt_tool_outputfile.exe"
;;
esac~
if test "$MANIFEST_TOOL" != ":" && test -f "$lt_outputfile.manifest"; then
$MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1;
$RM "$lt_outputfile.manifest";
fi'
;;
*)
# Assume MSVC wrapper
hardcode_libdir_flag_spec_F77=' '
allow_undefined_flag_F77=unsupported
# Tell ltmain to make .lib files, not .a files.
libext=lib
# Tell ltmain to make .dll files, not .so files.
shrext_cmds=".dll"
# FIXME: Setting linknames here is a bad hack.
archive_cmds_F77='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames='
# The linker will automatically build a .lib file if we build a DLL.
old_archive_from_new_cmds_F77='true'
# FIXME: Should let the user specify the lib program.
old_archive_cmds_F77='lib -OUT:$oldlib$oldobjs$old_deplibs'
enable_shared_with_static_runtimes_F77=yes
;;
esac
;;
darwin* | rhapsody*)
archive_cmds_need_lc_F77=no
hardcode_direct_F77=no
hardcode_automatic_F77=yes
hardcode_shlibpath_var_F77=unsupported
if test "$lt_cv_ld_force_load" = "yes"; then
whole_archive_flag_spec_F77='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`'
compiler_needs_object_F77=yes
else
whole_archive_flag_spec_F77=''
fi
link_all_deplibs_F77=yes
allow_undefined_flag_F77="$_lt_dar_allow_undefined"
case $cc_basename in
ifort*) _lt_dar_can_shared=yes ;;
*) _lt_dar_can_shared=$GCC ;;
esac
if test "$_lt_dar_can_shared" = "yes"; then
output_verbose_link_cmd=func_echo_all
archive_cmds_F77="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod${_lt_dsymutil}"
module_cmds_F77="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}"
archive_expsym_cmds_F77="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring ${_lt_dar_single_mod}${_lt_dar_export_syms}${_lt_dsymutil}"
module_expsym_cmds_F77="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}"
else
ld_shlibs_F77=no
fi
;;
dgux*)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_shlibpath_var_F77=no
;;
# FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
# support. Future versions do this automatically, but an explicit c++rt0.o
# does not break anything, and helps significantly (at the cost of a little
# extra space).
freebsd2.2*)
archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
hardcode_libdir_flag_spec_F77='-R$libdir'
hardcode_direct_F77=yes
hardcode_shlibpath_var_F77=no
;;
# Unfortunately, older versions of FreeBSD 2 do not have this feature.
freebsd2.*)
archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct_F77=yes
hardcode_minus_L_F77=yes
hardcode_shlibpath_var_F77=no
;;
# FreeBSD 3 and greater uses gcc -shared to do shared libraries.
freebsd* | dragonfly*)
archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
hardcode_libdir_flag_spec_F77='-R$libdir'
hardcode_direct_F77=yes
hardcode_shlibpath_var_F77=no
;;
hpux9*)
if test "$GCC" = yes; then
archive_cmds_F77='$RM $output_objdir/$soname~$CC -shared $pic_flag ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
else
archive_cmds_F77='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib'
fi
hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir'
hardcode_libdir_separator_F77=:
hardcode_direct_F77=yes
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L_F77=yes
export_dynamic_flag_spec_F77='${wl}-E'
;;
hpux10*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
archive_cmds_F77='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds_F77='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'
fi
if test "$with_gnu_ld" = no; then
hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir'
hardcode_libdir_separator_F77=:
hardcode_direct_F77=yes
hardcode_direct_absolute_F77=yes
export_dynamic_flag_spec_F77='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L_F77=yes
fi
;;
hpux11*)
if test "$GCC" = yes && test "$with_gnu_ld" = no; then
case $host_cpu in
hppa*64*)
archive_cmds_F77='$CC -shared ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
archive_cmds_F77='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
archive_cmds_F77='$CC -shared $pic_flag ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
else
case $host_cpu in
hppa*64*)
archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
;;
ia64*)
archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags'
;;
*)
archive_cmds_F77='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags'
;;
esac
fi
if test "$with_gnu_ld" = no; then
hardcode_libdir_flag_spec_F77='${wl}+b ${wl}$libdir'
hardcode_libdir_separator_F77=:
case $host_cpu in
hppa*64*|ia64*)
hardcode_direct_F77=no
hardcode_shlibpath_var_F77=no
;;
*)
hardcode_direct_F77=yes
hardcode_direct_absolute_F77=yes
export_dynamic_flag_spec_F77='${wl}-E'
# hardcode_minus_L: Not really in the search PATH,
# but as the default location of the library.
hardcode_minus_L_F77=yes
;;
esac
fi
;;
irix5* | irix6* | nonstopux*)
if test "$GCC" = yes; then
archive_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
# Try to use the -exported_symbol ld option, if it does not
# work, assume that -exports_file does not work either and
# implicitly export all symbols.
# This should be the same for all languages, so no per-tag cache variable.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5
$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; }
if ${lt_cv_irix_exported_symbol+:} false; then :
$as_echo_n "(cached) " >&6
else
save_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null"
cat > conftest.$ac_ext <<_ACEOF
subroutine foo
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
lt_cv_irix_exported_symbol=yes
else
lt_cv_irix_exported_symbol=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS="$save_LDFLAGS"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5
$as_echo "$lt_cv_irix_exported_symbol" >&6; }
if test "$lt_cv_irix_exported_symbol" = yes; then
archive_expsym_cmds_F77='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib'
fi
else
archive_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
archive_expsym_cmds_F77='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib'
fi
archive_cmds_need_lc_F77='no'
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator_F77=:
inherit_rpath_F77=yes
link_all_deplibs_F77=yes
;;
netbsd*)
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out
else
archive_cmds_F77='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF
fi
hardcode_libdir_flag_spec_F77='-R$libdir'
hardcode_direct_F77=yes
hardcode_shlibpath_var_F77=no
;;
newsos6)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct_F77=yes
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator_F77=:
hardcode_shlibpath_var_F77=no
;;
*nto* | *qnx*)
;;
openbsd*)
if test -f /usr/libexec/ld.so; then
hardcode_direct_F77=yes
hardcode_shlibpath_var_F77=no
hardcode_direct_absolute_F77=yes
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols'
hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir'
export_dynamic_flag_spec_F77='${wl}-E'
else
case $host_os in
openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*)
archive_cmds_F77='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec_F77='-R$libdir'
;;
*)
archive_cmds_F77='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags'
hardcode_libdir_flag_spec_F77='${wl}-rpath,$libdir'
;;
esac
fi
else
ld_shlibs_F77=no
fi
;;
os2*)
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_minus_L_F77=yes
allow_undefined_flag_F77=unsupported
archive_cmds_F77='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
old_archive_from_new_cmds_F77='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
;;
osf3*)
if test "$GCC" = yes; then
allow_undefined_flag_F77=' ${wl}-expect_unresolved ${wl}\*'
archive_cmds_F77='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
else
allow_undefined_flag_F77=' -expect_unresolved \*'
archive_cmds_F77='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
fi
archive_cmds_need_lc_F77='no'
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
hardcode_libdir_separator_F77=:
;;
osf4* | osf5*) # as osf3* with the addition of -msym flag
if test "$GCC" = yes; then
allow_undefined_flag_F77=' ${wl}-expect_unresolved ${wl}\*'
archive_cmds_F77='$CC -shared${allow_undefined_flag} $pic_flag $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
hardcode_libdir_flag_spec_F77='${wl}-rpath ${wl}$libdir'
else
allow_undefined_flag_F77=' -expect_unresolved \*'
archive_cmds_F77='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib'
archive_expsym_cmds_F77='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~
$CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp'
# Both c and cxx compiler support -rpath directly
hardcode_libdir_flag_spec_F77='-rpath $libdir'
fi
archive_cmds_need_lc_F77='no'
hardcode_libdir_separator_F77=:
;;
solaris*)
no_undefined_flag_F77=' -z defs'
if test "$GCC" = yes; then
wlarc='${wl}'
archive_cmds_F77='$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -shared $pic_flag ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
else
case `$CC -V 2>&1` in
*"Compilers 5.0"*)
wlarc=''
archive_cmds_F77='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp'
;;
*)
wlarc='${wl}'
archive_cmds_F77='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~
$CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp'
;;
esac
fi
hardcode_libdir_flag_spec_F77='-R$libdir'
hardcode_shlibpath_var_F77=no
case $host_os in
solaris2.[0-5] | solaris2.[0-5].*) ;;
*)
# The compiler driver will combine and reorder linker options,
# but understands `-z linker_flag'. GCC discards it without `$wl',
# but is careful enough not to reorder.
# Supported since Solaris 2.6 (maybe 2.5.1?)
if test "$GCC" = yes; then
whole_archive_flag_spec_F77='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract'
else
whole_archive_flag_spec_F77='-z allextract$convenience -z defaultextract'
fi
;;
esac
link_all_deplibs_F77=yes
;;
sunos4*)
if test "x$host_vendor" = xsequent; then
# Use $CC to link under sequent, because it throws in some extra .o
# files that make .init and .fini sections work.
archive_cmds_F77='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds_F77='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
fi
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_direct_F77=yes
hardcode_minus_L_F77=yes
hardcode_shlibpath_var_F77=no
;;
sysv4)
case $host_vendor in
sni)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct_F77=yes # is this really true???
;;
siemens)
## LD is ld it makes a PLAMLIB
## CC just makes a GrossModule.
archive_cmds_F77='$LD -G -o $lib $libobjs $deplibs $linker_flags'
reload_cmds_F77='$CC -r -o $output$reload_objs'
hardcode_direct_F77=no
;;
motorola)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_direct_F77=no #Motorola manual says yes, but my tests say they lie
;;
esac
runpath_var='LD_RUN_PATH'
hardcode_shlibpath_var_F77=no
;;
sysv4.3*)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_shlibpath_var_F77=no
export_dynamic_flag_spec_F77='-Bexport'
;;
sysv4*MP*)
if test -d /usr/nec; then
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_shlibpath_var_F77=no
runpath_var=LD_RUN_PATH
hardcode_runpath_var=yes
ld_shlibs_F77=yes
fi
;;
sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*)
no_undefined_flag_F77='${wl}-z,text'
archive_cmds_need_lc_F77=no
hardcode_shlibpath_var_F77=no
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
archive_cmds_F77='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds_F77='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
sysv5* | sco3.2v5* | sco5v6*)
# Note: We can NOT use -z defs as we might desire, because we do not
# link with -lc, and that would cause any symbols used from libc to
# always be unresolved, which means just about no library would
# ever link correctly. If we're not using GNU ld we use -z text
# though, which does catch some bad symbols but isn't as heavy-handed
# as -z defs.
no_undefined_flag_F77='${wl}-z,text'
allow_undefined_flag_F77='${wl}-z,nodefs'
archive_cmds_need_lc_F77=no
hardcode_shlibpath_var_F77=no
hardcode_libdir_flag_spec_F77='${wl}-R,$libdir'
hardcode_libdir_separator_F77=':'
link_all_deplibs_F77=yes
export_dynamic_flag_spec_F77='${wl}-Bexport'
runpath_var='LD_RUN_PATH'
if test "$GCC" = yes; then
archive_cmds_F77='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
else
archive_cmds_F77='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
archive_expsym_cmds_F77='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags'
fi
;;
uts4*)
archive_cmds_F77='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
hardcode_libdir_flag_spec_F77='-L$libdir'
hardcode_shlibpath_var_F77=no
;;
*)
ld_shlibs_F77=no
;;
esac
if test x$host_vendor = xsni; then
case $host in
sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
export_dynamic_flag_spec_F77='${wl}-Blargedynsym'
;;
esac
fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs_F77" >&5
$as_echo "$ld_shlibs_F77" >&6; }
test "$ld_shlibs_F77" = no && can_build_shared=no
with_gnu_ld_F77=$with_gnu_ld
#
# Do we need to explicitly link libc?
#
case "x$archive_cmds_need_lc_F77" in
x|xyes)
# Assume -lc should be added
archive_cmds_need_lc_F77=yes
if test "$enable_shared" = yes && test "$GCC" = yes; then
case $archive_cmds_F77 in
*'~'*)
# FIXME: we may have to deal with multi-command sequences.
;;
'$CC '*)
# Test whether the compiler implicitly links with -lc since on some
# systems, -lgcc has to come before -lc. If gcc already passes -lc
# to ld, don't add -lc before -lgcc.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5
$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; }
if ${lt_cv_archive_cmds_need_lc_F77+:} false; then :
$as_echo_n "(cached) " >&6
else
$RM conftest*
echo "$lt_simple_compile_test_code" > conftest.$ac_ext
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5
(eval $ac_compile) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; } 2>conftest.err; then
soname=conftest
lib=conftest
libobjs=conftest.$ac_objext
deplibs=
wl=$lt_prog_compiler_wl_F77
pic_flag=$lt_prog_compiler_pic_F77
compiler_flags=-v
linker_flags=-v
verstring=
output_objdir=.
libname=conftest
lt_save_allow_undefined_flag=$allow_undefined_flag_F77
allow_undefined_flag_F77=
if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5
(eval $archive_cmds_F77 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5
ac_status=$?
$as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
test $ac_status = 0; }
then
lt_cv_archive_cmds_need_lc_F77=no
else
lt_cv_archive_cmds_need_lc_F77=yes
fi
allow_undefined_flag_F77=$lt_save_allow_undefined_flag
else
cat conftest.err 1>&5
fi
$RM conftest*
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc_F77" >&5
$as_echo "$lt_cv_archive_cmds_need_lc_F77" >&6; }
archive_cmds_need_lc_F77=$lt_cv_archive_cmds_need_lc_F77
;;
esac
fi
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5
$as_echo_n "checking dynamic linker characteristics... " >&6; }
library_names_spec=
libname_spec='lib$name'
soname_spec=
shrext_cmds=".so"
postinstall_cmds=
postuninstall_cmds=
finish_cmds=
finish_eval=
shlibpath_var=
shlibpath_overrides_runpath=unknown
version_type=none
dynamic_linker="$host_os ld.so"
sys_lib_dlsearch_path_spec="/lib /usr/lib"
need_lib_prefix=unknown
hardcode_into_libs=no
# when you set need_version to no, make sure it does not cause -set_version
# flags to be left without arguments
need_version=unknown
case $host_os in
aix3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a'
shlibpath_var=LIBPATH
# AIX 3 has no versioning support, so we append a major version to the name.
soname_spec='${libname}${release}${shared_ext}$major'
;;
aix[4-9]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
hardcode_into_libs=yes
if test "$host_cpu" = ia64; then
# AIX 5 supports IA64
library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
else
# With GCC up to 2.95.x, collect2 would create an import file
# for dependence libraries. The import file would start with
# the line `#! .'. This would cause the generated library to
# depend on `.', always an invalid library. This was fixed in
# development snapshots of GCC prior to 3.0.
case $host_os in
aix4 | aix4.[01] | aix4.[01].*)
if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)'
echo ' yes '
echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then
:
else
can_build_shared=no
fi
;;
esac
# AIX (on Power*) has no versioning support, so currently we can not hardcode correct
# soname into executable. Probably we can add versioning support to
# collect2, so additional links can be useful in future.
if test "$aix_use_runtimelinking" = yes; then
# If using run time linking (on AIX 4.2 or later) use lib.so
# instead of lib.a to let people know that these are not
# typical AIX shared libraries.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
else
# We preserve .a as extension for shared libraries through AIX4.2
# and later when we are not doing run time linking.
library_names_spec='${libname}${release}.a $libname.a'
soname_spec='${libname}${release}${shared_ext}$major'
fi
shlibpath_var=LIBPATH
fi
;;
amigaos*)
case $host_cpu in
powerpc)
# Since July 2007 AmigaOS4 officially supports .so libraries.
# When compiling the executable, add -use-dynld -Lsobjs: to the compileline.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
;;
m68k)
library_names_spec='$libname.ixlibrary $libname.a'
# Create ${libname}_ixlibrary.a entries in /sys/libs.
finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done'
;;
esac
;;
beos*)
library_names_spec='${libname}${shared_ext}'
dynamic_linker="$host_os ld.so"
shlibpath_var=LIBRARY_PATH
;;
bsdi[45]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
# the default ld.so.conf also contains /usr/contrib/lib and
# /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
# libtool to hard-code these into programs
;;
cygwin* | mingw* | pw32* | cegcc*)
version_type=windows
shrext_cmds=".dll"
need_version=no
need_lib_prefix=no
case $GCC,$cc_basename in
yes,*)
# gcc
library_names_spec='$libname.dll.a'
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname~
chmod a+x \$dldir/$dlname~
if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then
eval '\''$striplib \$dldir/$dlname'\'' || exit \$?;
fi'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
case $host_os in
cygwin*)
# Cygwin DLLs use 'cyg' prefix rather than 'lib'
soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
;;
mingw* | cegcc*)
# MinGW DLLs use traditional 'lib' prefix
soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
;;
pw32*)
# pw32 DLLs use 'pw' prefix rather than 'lib'
library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
;;
esac
dynamic_linker='Win32 ld.exe'
;;
*,cl*)
# Native MSVC
libname_spec='$name'
soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}'
library_names_spec='${libname}.dll.lib'
case $build_os in
mingw*)
sys_lib_search_path_spec=
lt_save_ifs=$IFS
IFS=';'
for lt_path in $LIB
do
IFS=$lt_save_ifs
# Let DOS variable expansion print the short 8.3 style file name.
lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"`
sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path"
done
IFS=$lt_save_ifs
# Convert to MSYS style.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'`
;;
cygwin*)
# Convert to unix form, then to dos form, then back to unix form
# but this time dos style (no spaces!) so that the unix form looks
# like /cygdrive/c/PROGRA~1:/cygdr...
sys_lib_search_path_spec=`cygpath --path --unix "$LIB"`
sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null`
sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
;;
*)
sys_lib_search_path_spec="$LIB"
if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then
# It is most probably a Windows format PATH.
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'`
else
sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"`
fi
# FIXME: find the short name or the path components, as spaces are
# common. (e.g. "Program Files" -> "PROGRA~1")
;;
esac
# DLL is installed to $(libdir)/../bin by postinstall_cmds
postinstall_cmds='base_file=`basename \${file}`~
dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~
dldir=$destdir/`dirname \$dlpath`~
test -d \$dldir || mkdir -p \$dldir~
$install_prog $dir/$dlname \$dldir/$dlname'
postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~
dlpath=$dir/\$dldll~
$RM \$dlpath'
shlibpath_overrides_runpath=yes
dynamic_linker='Win32 link.exe'
;;
*)
# Assume MSVC wrapper
library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib'
dynamic_linker='Win32 ld.exe'
;;
esac
# FIXME: first we should search . and the directory the executable is in
shlibpath_var=PATH
;;
darwin* | rhapsody*)
dynamic_linker="$host_os dyld"
version_type=darwin
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext'
soname_spec='${libname}${release}${major}$shared_ext'
shlibpath_overrides_runpath=yes
shlibpath_var=DYLD_LIBRARY_PATH
shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`'
sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib'
;;
dgux*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
freebsd* | dragonfly*)
# DragonFly does not have aout. When/if they implement a new
# versioning mechanism, adjust this.
if test -x /usr/bin/objformat; then
objformat=`/usr/bin/objformat`
else
case $host_os in
freebsd[23].*) objformat=aout ;;
*) objformat=elf ;;
esac
fi
version_type=freebsd-$objformat
case $version_type in
freebsd-elf*)
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
need_version=no
need_lib_prefix=no
;;
freebsd-*)
library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix'
need_version=yes
;;
esac
shlibpath_var=LD_LIBRARY_PATH
case $host_os in
freebsd2.*)
shlibpath_overrides_runpath=yes
;;
freebsd3.[01]* | freebsdelf3.[01]*)
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
freebsd3.[2-9]* | freebsdelf3.[2-9]* | \
freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1)
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
*) # from 4.6 on, and DragonFly
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
esac
;;
gnu*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
haiku*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
dynamic_linker="$host_os runtime_loader"
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LIBRARY_PATH
shlibpath_overrides_runpath=yes
sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib'
hardcode_into_libs=yes
;;
hpux9* | hpux10* | hpux11*)
# Give a soname corresponding to the major version so that dld.sl refuses to
# link against other versions.
version_type=sunos
need_lib_prefix=no
need_version=no
case $host_cpu in
ia64*)
shrext_cmds='.so'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.so"
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
if test "X$HPUX_IA64_MODE" = X32; then
sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib"
else
sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64"
fi
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
hppa*64*)
shrext_cmds='.sl'
hardcode_into_libs=yes
dynamic_linker="$host_os dld.sl"
shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH
shlibpath_overrides_runpath=yes # Unless +noenvvar is specified.
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64"
sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec
;;
*)
shrext_cmds='.sl'
dynamic_linker="$host_os dld.sl"
shlibpath_var=SHLIB_PATH
shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
;;
esac
# HP-UX runs *really* slowly unless shared libraries are mode 555, ...
postinstall_cmds='chmod 555 $lib'
# or fails outright, so override atomically:
install_override_mode=555
;;
interix[3-9]*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
irix5* | irix6* | nonstopux*)
case $host_os in
nonstopux*) version_type=nonstopux ;;
*)
if test "$lt_cv_prog_gnu_ld" = yes; then
version_type=linux # correct to gnu/linux during the next big refactor
else
version_type=irix
fi ;;
esac
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}'
case $host_os in
irix5* | nonstopux*)
libsuff= shlibsuff=
;;
*)
case $LD in # libtool.m4 will add one of these switches to LD
*-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ")
libsuff= shlibsuff= libmagic=32-bit;;
*-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ")
libsuff=32 shlibsuff=N32 libmagic=N32;;
*-64|*"-64 "|*-melf64bmip|*"-melf64bmip ")
libsuff=64 shlibsuff=64 libmagic=64-bit;;
*) libsuff= shlibsuff= libmagic=never-match;;
esac
;;
esac
shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
shlibpath_overrides_runpath=no
sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
hardcode_into_libs=yes
;;
# No shared lib support for Linux oldld, aout, or coff.
linux*oldld* | linux*aout* | linux*coff*)
dynamic_linker=no
;;
# This must be glibc/ELF.
linux* | k*bsd*-gnu | kopensolaris*-gnu)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
# Some binutils ld are patched to set DT_RUNPATH
if ${lt_cv_shlibpath_overrides_runpath+:} false; then :
$as_echo_n "(cached) " >&6
else
lt_cv_shlibpath_overrides_runpath=no
save_LDFLAGS=$LDFLAGS
save_libdir=$libdir
eval "libdir=/foo; wl=\"$lt_prog_compiler_wl_F77\"; \
LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec_F77\""
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then :
lt_cv_shlibpath_overrides_runpath=yes
fi
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LDFLAGS=$save_LDFLAGS
libdir=$save_libdir
fi
shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath
# This implies no fast_install, which is unacceptable.
# Some rework will be needed to allow for fast_install
# before this can be enabled.
hardcode_into_libs=yes
# Add ABI-specific directories to the system library path.
sys_lib_dlsearch_path_spec="/lib64 /usr/lib64 /lib /usr/lib"
# Append ld.so.conf contents to the search path
if test -f /etc/ld.so.conf; then
lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '`
sys_lib_dlsearch_path_spec="$sys_lib_dlsearch_path_spec $lt_ld_extra"
fi
# We used to test for /lib/ld.so.1 and disable shared libraries on
# powerpc, because MkLinux only supported shared libraries with the
# GNU dynamic linker. Since this was broken with cross compilers,
# most powerpc-linux boxes support dynamic linking these days and
# people can always --disable-shared, the test was removed, and we
# assume the GNU/Linux dynamic linker is in use.
dynamic_linker='GNU/Linux ld.so'
;;
netbsd*)
version_type=sunos
need_lib_prefix=no
need_version=no
if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
dynamic_linker='NetBSD (a.out) ld.so'
else
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
dynamic_linker='NetBSD ld.elf_so'
fi
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
;;
newsos6)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
;;
*nto* | *qnx*)
version_type=qnx
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
dynamic_linker='ldqnx.so'
;;
openbsd*)
version_type=sunos
sys_lib_dlsearch_path_spec="/usr/lib"
need_lib_prefix=no
# Some older versions of OpenBSD (3.3 at least) *do* need versioned libs.
case $host_os in
openbsd3.3 | openbsd3.3.*) need_version=yes ;;
*) need_version=no ;;
esac
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
shlibpath_var=LD_LIBRARY_PATH
if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then
case $host_os in
openbsd2.[89] | openbsd2.[89].*)
shlibpath_overrides_runpath=no
;;
*)
shlibpath_overrides_runpath=yes
;;
esac
else
shlibpath_overrides_runpath=yes
fi
;;
os2*)
libname_spec='$name'
shrext_cmds=".dll"
need_lib_prefix=no
library_names_spec='$libname${shared_ext} $libname.a'
dynamic_linker='OS/2 ld.exe'
shlibpath_var=LIBPATH
;;
osf3* | osf4* | osf5*)
version_type=osf
need_lib_prefix=no
need_version=no
soname_spec='${libname}${release}${shared_ext}$major'
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
;;
rdos*)
dynamic_linker=no
;;
solaris*)
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
# ldd complains unless libraries are executable
postinstall_cmds='chmod +x $lib'
;;
sunos4*)
version_type=sunos
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix'
finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
if test "$with_gnu_ld" = yes; then
need_lib_prefix=no
fi
need_version=yes
;;
sysv4 | sysv4.3*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
case $host_vendor in
sni)
shlibpath_overrides_runpath=no
need_lib_prefix=no
runpath_var=LD_RUN_PATH
;;
siemens)
need_lib_prefix=no
;;
motorola)
need_lib_prefix=no
need_version=no
shlibpath_overrides_runpath=no
sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
;;
esac
;;
sysv4*MP*)
if test -d /usr/nec ;then
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}'
soname_spec='$libname${shared_ext}.$major'
shlibpath_var=LD_LIBRARY_PATH
fi
;;
sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*)
version_type=freebsd-elf
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=yes
hardcode_into_libs=yes
if test "$with_gnu_ld" = yes; then
sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib'
else
sys_lib_search_path_spec='/usr/ccs/lib /usr/lib'
case $host_os in
sco3.2v5*)
sys_lib_search_path_spec="$sys_lib_search_path_spec /lib"
;;
esac
fi
sys_lib_dlsearch_path_spec='/usr/lib'
;;
tpf*)
# TPF is a cross-target only. Preferred cross-host = GNU/Linux.
version_type=linux # correct to gnu/linux during the next big refactor
need_lib_prefix=no
need_version=no
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
shlibpath_var=LD_LIBRARY_PATH
shlibpath_overrides_runpath=no
hardcode_into_libs=yes
;;
uts4*)
version_type=linux # correct to gnu/linux during the next big refactor
library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}'
soname_spec='${libname}${release}${shared_ext}$major'
shlibpath_var=LD_LIBRARY_PATH
;;
*)
dynamic_linker=no
;;
esac
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5
$as_echo "$dynamic_linker" >&6; }
test "$dynamic_linker" = no && can_build_shared=no
variables_saved_for_relink="PATH $shlibpath_var $runpath_var"
if test "$GCC" = yes; then
variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH"
fi
if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then
sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec"
fi
if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then
sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5
$as_echo_n "checking how to hardcode library paths into programs... " >&6; }
hardcode_action_F77=
if test -n "$hardcode_libdir_flag_spec_F77" ||
test -n "$runpath_var_F77" ||
test "X$hardcode_automatic_F77" = "Xyes" ; then
# We can hardcode non-existent directories.
if test "$hardcode_direct_F77" != no &&
# If the only mechanism to avoid hardcoding is shlibpath_var, we
# have to relink, otherwise we might link with an installed library
# when we should be linking with a yet-to-be-installed one
## test "$_LT_TAGVAR(hardcode_shlibpath_var, F77)" != no &&
test "$hardcode_minus_L_F77" != no; then
# Linking always hardcodes the temporary library directory.
hardcode_action_F77=relink
else
# We can link without hardcoding, and we can hardcode nonexisting dirs.
hardcode_action_F77=immediate
fi
else
# We cannot hardcode anything, or else we can only hardcode existing
# directories.
hardcode_action_F77=unsupported
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action_F77" >&5
$as_echo "$hardcode_action_F77" >&6; }
if test "$hardcode_action_F77" = relink ||
test "$inherit_rpath_F77" = yes; then
# Fast installation is not supported
enable_fast_install=no
elif test "$shlibpath_overrides_runpath" = yes ||
test "$enable_shared" = no; then
# Fast installation is not necessary
enable_fast_install=needless
fi
fi # test -n "$compiler"
GCC=$lt_save_GCC
CC="$lt_save_CC"
CFLAGS="$lt_save_CFLAGS"
fi # test "$_lt_disable_F77" != yes
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_config_commands="$ac_config_commands libtool"
# Only expand once:
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to get verbose linking output from $F77" >&5
$as_echo_n "checking how to get verbose linking output from $F77... " >&6; }
if ${ac_cv_prog_f77_v+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
if ac_fn_f77_try_compile "$LINENO"; then :
ac_cv_prog_f77_v=
# Try some options frequently used verbose output
for ac_verb in -v -verbose --verbose -V -\#\#\#; do
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
# Compile and link our simple test program by passing a flag (argument
# 1 to this macro) to the Fortran compiler in order to get
# "verbose" output that we can then parse for the Fortran linker
# flags.
ac_save_FFLAGS=$FFLAGS
FFLAGS="$FFLAGS $ac_verb"
eval "set x $ac_link"
shift
$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
# LIBRARY_PATH; skip all such settings.
ac_f77_v_output=`eval $ac_link 5>&1 2>&1 |
sed '/^Driving:/d; /^Configured with:/d;
'"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"`
$as_echo "$ac_f77_v_output" >&5
FFLAGS=$ac_save_FFLAGS
rm -rf conftest*
# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
# /foo, /bar, and /baz are search directories for the Fortran linker.
# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
ac_f77_v_output="`echo $ac_f77_v_output |
grep 'LPATH is:' |
sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output"
# FIXME: we keep getting bitten by quoted arguments; a more general fix
# that detects unbalanced quotes in FLIBS should be implemented
# and (ugh) tested at some point.
case $ac_f77_v_output in
# With xlf replace commas with spaces,
# and remove "-link" and closing parenthesis.
*xlfentry*)
ac_f77_v_output=`echo $ac_f77_v_output |
sed '
s/,/ /g
s/ -link / /g
s/) *$//
'
` ;;
# With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted
# $LIBS confuse us, and the libraries appear later in the output anyway).
*mGLOB_options_string*)
ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;;
# Portland Group compiler has singly- or doubly-quoted -cmdline argument
# Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4.
# Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
*-cmdline\ * | *-ignore\ * | *-def\ *)
ac_f77_v_output=`echo $ac_f77_v_output | sed "\
s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
# If we are using fort77 (the f2c wrapper) then filter output and delete quotes.
*fort77*f2c*gcc*)
ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n '
/:[ ]\+Running[ ]\{1,\}"gcc"/{
/"-c"/d
/[.]c"*/d
s/^.*"gcc"/"gcc"/
s/"//gp
}'` ;;
# If we are using Cray Fortran then delete quotes.
*cft90*)
ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;;
esac
# look for -l* and *.a constructs in the output
for ac_arg in $ac_f77_v_output; do
case $ac_arg in
[\\/]*.a | ?:[\\/]*.a | -[lLRu]*)
ac_cv_prog_f77_v=$ac_verb
break 2 ;;
esac
done
done
if test -z "$ac_cv_prog_f77_v"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot determine how to obtain linking information from $F77" >&5
$as_echo "$as_me: WARNING: cannot determine how to obtain linking information from $F77" >&2;}
fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: compilation failed" >&5
$as_echo "$as_me: WARNING: compilation failed" >&2;}
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_f77_v" >&5
$as_echo "$ac_cv_prog_f77_v" >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 libraries of $F77" >&5
$as_echo_n "checking for Fortran 77 libraries of $F77... " >&6; }
if ${ac_cv_f77_libs+:} false; then :
$as_echo_n "(cached) " >&6
else
if test "x$FLIBS" != "x"; then
ac_cv_f77_libs="$FLIBS" # Let the user override the test.
else
cat > conftest.$ac_ext <<_ACEOF
program main
end
_ACEOF
# Compile and link our simple test program by passing a flag (argument
# 1 to this macro) to the Fortran compiler in order to get
# "verbose" output that we can then parse for the Fortran linker
# flags.
ac_save_FFLAGS=$FFLAGS
FFLAGS="$FFLAGS $ac_cv_prog_f77_v"
eval "set x $ac_link"
shift
$as_echo "$as_me:${as_lineno-$LINENO}: $*" >&5
# gfortran 4.3 outputs lines setting COLLECT_GCC_OPTIONS, COMPILER_PATH,
# LIBRARY_PATH; skip all such settings.
ac_f77_v_output=`eval $ac_link 5>&1 2>&1 |
sed '/^Driving:/d; /^Configured with:/d;
'"/^[_$as_cr_Letters][_$as_cr_alnum]*=/d"`
$as_echo "$ac_f77_v_output" >&5
FFLAGS=$ac_save_FFLAGS
rm -rf conftest*
# On HP/UX there is a line like: "LPATH is: /foo:/bar:/baz" where
# /foo, /bar, and /baz are search directories for the Fortran linker.
# Here, we change these into -L/foo -L/bar -L/baz (and put it first):
ac_f77_v_output="`echo $ac_f77_v_output |
grep 'LPATH is:' |
sed 's|.*LPATH is\(: *[^ ]*\).*|\1|;s|: */| -L/|g'` $ac_f77_v_output"
# FIXME: we keep getting bitten by quoted arguments; a more general fix
# that detects unbalanced quotes in FLIBS should be implemented
# and (ugh) tested at some point.
case $ac_f77_v_output in
# With xlf replace commas with spaces,
# and remove "-link" and closing parenthesis.
*xlfentry*)
ac_f77_v_output=`echo $ac_f77_v_output |
sed '
s/,/ /g
s/ -link / /g
s/) *$//
'
` ;;
# With Intel ifc, ignore the quoted -mGLOB_options_string stuff (quoted
# $LIBS confuse us, and the libraries appear later in the output anyway).
*mGLOB_options_string*)
ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"-mGLOB[^"]*"/ /g'` ;;
# Portland Group compiler has singly- or doubly-quoted -cmdline argument
# Singly-quoted arguments were reported for versions 5.2-4 and 6.0-4.
# Doubly-quoted arguments were reported for "PGF90/x86 Linux/x86 5.0-2".
*-cmdline\ * | *-ignore\ * | *-def\ *)
ac_f77_v_output=`echo $ac_f77_v_output | sed "\
s/-cmdline *'[^']*'/ /g; s/-cmdline *\"[^\"]*\"/ /g
s/-ignore *'[^']*'/ /g; s/-ignore *\"[^\"]*\"/ /g
s/-def *'[^']*'/ /g; s/-def *\"[^\"]*\"/ /g"` ;;
# If we are using fort77 (the f2c wrapper) then filter output and delete quotes.
*fort77*f2c*gcc*)
ac_f77_v_output=`echo "$ac_f77_v_output" | sed -n '
/:[ ]\+Running[ ]\{1,\}"gcc"/{
/"-c"/d
/[.]c"*/d
s/^.*"gcc"/"gcc"/
s/"//gp
}'` ;;
# If we are using Cray Fortran then delete quotes.
*cft90*)
ac_f77_v_output=`echo $ac_f77_v_output | sed 's/"//g'` ;;
esac
ac_cv_f77_libs=
# Save positional arguments (if any)
ac_save_positional="$@"
set X $ac_f77_v_output
while test $# != 1; do
shift
ac_arg=$1
case $ac_arg in
[\\/]*.a | ?:[\\/]*.a)
ac_exists=false
for ac_i in $ac_cv_f77_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
break
fi
done
if test x"$ac_exists" = xtrue; then :
else
ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg"
fi
;;
-bI:*)
ac_exists=false
for ac_i in $ac_cv_f77_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
break
fi
done
if test x"$ac_exists" = xtrue; then :
else
if test "$ac_compiler_gnu" = yes; then
for ac_link_opt in $ac_arg; do
ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt"
done
else
ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg"
fi
fi
;;
# Ignore these flags.
-lang* | -lcrt*.o | -lc | -lgcc* | -lSystem | -libmil | -little \
|-LANG:=* | -LIST:* | -LNO:* | -link)
;;
-lkernel32)
case $host_os in
*cygwin*) ;;
*) ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg"
;;
esac
;;
-[LRuYz])
# These flags, when seen by themselves, take an argument.
# We remove the space between option and argument and re-iterate
# unless we find an empty arg or a new option (starting with -)
case $2 in
"" | -*);;
*)
ac_arg="$ac_arg$2"
shift; shift
set X $ac_arg "$@"
;;
esac
;;
-YP,*)
for ac_j in `$as_echo "$ac_arg" | sed -e 's/-YP,/-L/;s/:/ -L/g'`; do
ac_exists=false
for ac_i in $ac_cv_f77_libs; do
if test x"$ac_j" = x"$ac_i"; then
ac_exists=true
break
fi
done
if test x"$ac_exists" = xtrue; then :
else
ac_arg="$ac_arg $ac_j"
ac_cv_f77_libs="$ac_cv_f77_libs $ac_j"
fi
done
;;
-[lLR]*)
ac_exists=false
for ac_i in $ac_cv_f77_libs; do
if test x"$ac_arg" = x"$ac_i"; then
ac_exists=true
break
fi
done
if test x"$ac_exists" = xtrue; then :
else
ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg"
fi
;;
-zallextract*| -zdefaultextract)
ac_cv_f77_libs="$ac_cv_f77_libs $ac_arg"
;;
# Ignore everything else.
esac
done
# restore positional arguments
set X $ac_save_positional; shift
# We only consider "LD_RUN_PATH" on Solaris systems. If this is seen,
# then we insist that the "run path" must be an absolute path (i.e. it
# must begin with a "/").
case `(uname -sr) 2>/dev/null` in
"SunOS 5"*)
ac_ld_run_path=`$as_echo "$ac_f77_v_output" |
sed -n 's,^.*LD_RUN_PATH *= *\(/[^ ]*\).*$,-R\1,p'`
test "x$ac_ld_run_path" != x &&
if test "$ac_compiler_gnu" = yes; then
for ac_link_opt in $ac_ld_run_path; do
ac_cv_f77_libs="$ac_cv_f77_libs -Xlinker $ac_link_opt"
done
else
ac_cv_f77_libs="$ac_cv_f77_libs $ac_ld_run_path"
fi
;;
esac
fi # test "x$[]_AC_LANG_PREFIX[]LIBS" = "x"
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_libs" >&5
$as_echo "$ac_cv_f77_libs" >&6; }
FLIBS="$ac_cv_f77_libs"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dummy main to link with Fortran 77 libraries" >&5
$as_echo_n "checking for dummy main to link with Fortran 77 libraries... " >&6; }
if ${ac_cv_f77_dummy_main+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_f77_dm_save_LIBS=$LIBS
LIBS="$LIBS $FLIBS"
ac_fortran_dm_var=F77_DUMMY_MAIN
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
# First, try linking without a dummy main:
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_fortran_dummy_main=none
else
ac_cv_fortran_dummy_main=unknown
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
if test $ac_cv_fortran_dummy_main = unknown; then
for ac_func in MAIN__ MAIN_ __main MAIN _MAIN __MAIN main_ main__ _main; do
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define $ac_fortran_dm_var $ac_func
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_fortran_dummy_main=$ac_func; break
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
done
fi
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
ac_cv_f77_dummy_main=$ac_cv_fortran_dummy_main
rm -rf conftest*
LIBS=$ac_f77_dm_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_dummy_main" >&5
$as_echo "$ac_cv_f77_dummy_main" >&6; }
F77_DUMMY_MAIN=$ac_cv_f77_dummy_main
if test "$F77_DUMMY_MAIN" != unknown; then :
if test $F77_DUMMY_MAIN != none; then
cat >>confdefs.h <<_ACEOF
#define F77_DUMMY_MAIN $F77_DUMMY_MAIN
_ACEOF
if test "x$ac_cv_fc_dummy_main" = "x$ac_cv_f77_dummy_main"; then
$as_echo "#define FC_DUMMY_MAIN_EQ_F77 1" >>confdefs.h
fi
fi
else
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "linking to Fortran libraries from C fails
See \`config.log' for more details" "$LINENO" 5; }
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Fortran 77 name-mangling scheme" >&5
$as_echo_n "checking for Fortran 77 name-mangling scheme... " >&6; }
if ${ac_cv_f77_mangling+:} false; then :
$as_echo_n "(cached) " >&6
else
cat > conftest.$ac_ext <<_ACEOF
subroutine foobar()
return
end
subroutine foo_bar()
return
end
_ACEOF
if ac_fn_f77_try_compile "$LINENO"; then :
mv conftest.$ac_objext cfortran_test.$ac_objext
ac_save_LIBS=$LIBS
LIBS="cfortran_test.$ac_objext $LIBS $FLIBS"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_success=no
for ac_foobar in foobar FOOBAR; do
for ac_underscore in "" "_"; do
ac_func="$ac_foobar$ac_underscore"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $ac_func ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $ac_func ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_success=yes; break 2
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
done
done
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
if test "$ac_success" = "yes"; then
case $ac_foobar in
foobar)
ac_case=lower
ac_foo_bar=foo_bar
;;
FOOBAR)
ac_case=upper
ac_foo_bar=FOO_BAR
;;
esac
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_success_extra=no
for ac_extra in "" "_"; do
ac_func="$ac_foo_bar$ac_underscore$ac_extra"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $ac_func ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $ac_func ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_success_extra=yes; break
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
done
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
if test "$ac_success_extra" = "yes"; then
ac_cv_f77_mangling="$ac_case case"
if test -z "$ac_underscore"; then
ac_cv_f77_mangling="$ac_cv_f77_mangling, no underscore"
else
ac_cv_f77_mangling="$ac_cv_f77_mangling, underscore"
fi
if test -z "$ac_extra"; then
ac_cv_f77_mangling="$ac_cv_f77_mangling, no extra underscore"
else
ac_cv_f77_mangling="$ac_cv_f77_mangling, extra underscore"
fi
else
ac_cv_f77_mangling="unknown"
fi
else
ac_cv_f77_mangling="unknown"
fi
LIBS=$ac_save_LIBS
rm -rf conftest*
rm -f cfortran_test*
else
{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot compile a simple Fortran program
See \`config.log' for more details" "$LINENO" 5; }
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_f77_mangling" >&5
$as_echo "$ac_cv_f77_mangling" >&6; }
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ax_blas_ok=no
# Check whether --with-blas was given.
if test "${with_blas+set}" = set; then :
withval=$with_blas;
fi
case $with_blas in
yes | "") ;;
no) ax_blas_ok=disable ;;
-* | */* | *.a | *.so | *.so.* | *.o) BLAS_LIBS="$with_blas" ;;
*) BLAS_LIBS="-l$with_blas" ;;
esac
# Get fortran linker names of BLAS functions to check for.
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
case $ac_cv_f77_mangling in
upper*) ac_val="SGEMM" ;;
lower*) ac_val="sgemm" ;;
*) ac_val="unknown" ;;
esac
case $ac_cv_f77_mangling in *," underscore"*) ac_val="$ac_val"_ ;; esac
sgemm="$ac_val"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
case $ac_cv_f77_mangling in
upper*) ac_val="DGEMM" ;;
lower*) ac_val="dgemm" ;;
*) ac_val="unknown" ;;
esac
case $ac_cv_f77_mangling in *," underscore"*) ac_val="$ac_val"_ ;; esac
dgemm="$ac_val"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
ax_blas_save_LIBS="$LIBS"
LIBS="$LIBS $FLIBS"
# First, check BLAS_LIBS environment variable
if test $ax_blas_ok = no; then
if test "x$BLAS_LIBS" != x; then
save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in $BLAS_LIBS" >&5
$as_echo_n "checking for $sgemm in $BLAS_LIBS... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ax_blas_ok=yes
else
BLAS_LIBS=""
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_blas_ok" >&5
$as_echo "$ax_blas_ok" >&6; }
LIBS="$save_LIBS"
fi
fi
# BLAS linked to by default? (happens on some supercomputers)
if test $ax_blas_ok = no; then
save_LIBS="$LIBS"; LIBS="$LIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $sgemm is being linked in already" >&5
$as_echo_n "checking if $sgemm is being linked in already... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ax_blas_ok=yes
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_blas_ok" >&5
$as_echo "$ax_blas_ok" >&6; }
LIBS="$save_LIBS"
fi
# BLAS in ATLAS library? (http://math-atlas.sourceforge.net/)
if test $ax_blas_ok = no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ATL_xerbla in -latlas" >&5
$as_echo_n "checking for ATL_xerbla in -latlas... " >&6; }
if ${ac_cv_lib_atlas_ATL_xerbla+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-latlas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char ATL_xerbla ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return ATL_xerbla ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_atlas_ATL_xerbla=yes
else
ac_cv_lib_atlas_ATL_xerbla=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_atlas_ATL_xerbla" >&5
$as_echo "$ac_cv_lib_atlas_ATL_xerbla" >&6; }
if test "x$ac_cv_lib_atlas_ATL_xerbla" = xyes; then :
as_ac_Lib=`$as_echo "ac_cv_lib_f77blas_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lf77blas" >&5
$as_echo_n "checking for $sgemm in -lf77blas... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lf77blas -latlas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cblas_dgemm in -lcblas" >&5
$as_echo_n "checking for cblas_dgemm in -lcblas... " >&6; }
if ${ac_cv_lib_cblas_cblas_dgemm+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lcblas -lf77blas -latlas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char cblas_dgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return cblas_dgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_cblas_cblas_dgemm=yes
else
ac_cv_lib_cblas_cblas_dgemm=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_cblas_cblas_dgemm" >&5
$as_echo "$ac_cv_lib_cblas_cblas_dgemm" >&6; }
if test "x$ac_cv_lib_cblas_cblas_dgemm" = xyes; then :
ax_blas_ok=yes
BLAS_LIBS="-lcblas -lf77blas -latlas"
fi
fi
fi
fi
# BLAS in PhiPACK libraries? (requires generic BLAS lib, too)
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lblas" >&5
$as_echo_n "checking for $sgemm in -lblas... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lblas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
as_ac_Lib=`$as_echo "ac_cv_lib_dgemm_$dgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $dgemm in -ldgemm" >&5
$as_echo_n "checking for $dgemm in -ldgemm... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldgemm -lblas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $dgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $dgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
as_ac_Lib=`$as_echo "ac_cv_lib_sgemm_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lsgemm" >&5
$as_echo_n "checking for $sgemm in -lsgemm... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lsgemm -lblas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes; BLAS_LIBS="-lsgemm -ldgemm -lblas"
fi
fi
fi
fi
# BLAS in Intel MKL library?
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_mkl_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lmkl" >&5
$as_echo_n "checking for $sgemm in -lmkl... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lmkl $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes;BLAS_LIBS="-lmkl"
fi
fi
# BLAS in Apple vecLib library?
if test $ax_blas_ok = no; then
save_LIBS="$LIBS"; LIBS="-framework vecLib $LIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -framework vecLib" >&5
$as_echo_n "checking for $sgemm in -framework vecLib... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ax_blas_ok=yes;BLAS_LIBS="-framework vecLib"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_blas_ok" >&5
$as_echo "$ax_blas_ok" >&6; }
LIBS="$save_LIBS"
fi
# BLAS in Alpha CXML library?
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_cxml_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lcxml" >&5
$as_echo_n "checking for $sgemm in -lcxml... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lcxml $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes;BLAS_LIBS="-lcxml"
fi
fi
# BLAS in Alpha DXML library? (now called CXML, see above)
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_dxml_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -ldxml" >&5
$as_echo_n "checking for $sgemm in -ldxml... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldxml $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes;BLAS_LIBS="-ldxml"
fi
fi
# BLAS in Sun Performance library?
if test $ax_blas_ok = no; then
if test "x$GCC" != xyes; then # only works with Sun CC
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for acosp in -lsunmath" >&5
$as_echo_n "checking for acosp in -lsunmath... " >&6; }
if ${ac_cv_lib_sunmath_acosp+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lsunmath $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char acosp ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return acosp ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_sunmath_acosp=yes
else
ac_cv_lib_sunmath_acosp=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_sunmath_acosp" >&5
$as_echo "$ac_cv_lib_sunmath_acosp" >&6; }
if test "x$ac_cv_lib_sunmath_acosp" = xyes; then :
as_ac_Lib=`$as_echo "ac_cv_lib_sunperf_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lsunperf" >&5
$as_echo_n "checking for $sgemm in -lsunperf... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lsunperf -lsunmath $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
BLAS_LIBS="-xlic_lib=sunperf -lsunmath"
ax_blas_ok=yes
fi
fi
fi
fi
# BLAS in SCSL library? (SGI/Cray Scientific Library)
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_scs_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lscs" >&5
$as_echo_n "checking for $sgemm in -lscs... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lscs $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes; BLAS_LIBS="-lscs"
fi
fi
# BLAS in SGIMATH library?
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_complib.sgimath_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lcomplib.sgimath" >&5
$as_echo_n "checking for $sgemm in -lcomplib.sgimath... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lcomplib.sgimath $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes; BLAS_LIBS="-lcomplib.sgimath"
fi
fi
# BLAS in IBM ESSL library? (requires generic BLAS lib, too)
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lblas" >&5
$as_echo_n "checking for $sgemm in -lblas... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lblas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
as_ac_Lib=`$as_echo "ac_cv_lib_essl_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lessl" >&5
$as_echo_n "checking for $sgemm in -lessl... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lessl -lblas $FLIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes; BLAS_LIBS="-lessl -lblas"
fi
fi
fi
# Generic BLAS library?
if test $ax_blas_ok = no; then
as_ac_Lib=`$as_echo "ac_cv_lib_blas_$sgemm" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $sgemm in -lblas" >&5
$as_echo_n "checking for $sgemm in -lblas... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lblas $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $sgemm ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $sgemm ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_blas_ok=yes; BLAS_LIBS="-lblas"
fi
fi
LIBS="$ax_blas_save_LIBS"
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$ax_blas_ok" = xyes; then
$as_echo "#define HAVE_BLAS 1" >>confdefs.h
:
else
ax_blas_ok=no
fi
if test "$ax_blas_ok" = "no"; then
as_fn_error $? "Cannot find BLAS libraries" "$LINENO" 5
fi
ax_lapack_ok=no
# Check whether --with-lapack was given.
if test "${with_lapack+set}" = set; then :
withval=$with_lapack;
fi
case $with_lapack in
yes | "") ;;
no) ax_lapack_ok=disable ;;
-* | */* | *.a | *.so | *.so.* | *.o) LAPACK_LIBS="$with_lapack" ;;
*) LAPACK_LIBS="-l$with_lapack" ;;
esac
# Get fortran linker name of LAPACK function to check for.
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
case $ac_cv_f77_mangling in
upper*) ac_val="CHEEV" ;;
lower*) ac_val="cheev" ;;
*) ac_val="unknown" ;;
esac
case $ac_cv_f77_mangling in *," underscore"*) ac_val="$ac_val"_ ;; esac
cheev="$ac_val"
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
# We cannot use LAPACK if BLAS is not found
if test "x$ax_blas_ok" != xyes; then
ax_lapack_ok=noblas
LAPACK_LIBS=""
fi
# First, check LAPACK_LIBS environment variable
if test "x$LAPACK_LIBS" != x; then
save_LIBS="$LIBS"; LIBS="$LAPACK_LIBS $BLAS_LIBS $LIBS $FLIBS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $cheev in $LAPACK_LIBS" >&5
$as_echo_n "checking for $cheev in $LAPACK_LIBS... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $cheev ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $cheev ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ax_lapack_ok=yes
else
LAPACK_LIBS=""
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_lapack_ok" >&5
$as_echo "$ax_lapack_ok" >&6; }
LIBS="$save_LIBS"
if test $ax_lapack_ok = no; then
LAPACK_LIBS=""
fi
fi
# LAPACK linked to by default? (is sometimes included in BLAS lib)
if test $ax_lapack_ok = no; then
save_LIBS="$LIBS"; LIBS="$LIBS $BLAS_LIBS $FLIBS"
as_ac_var=`$as_echo "ac_cv_func_$cheev" | $as_tr_sh`
ac_fn_c_check_func "$LINENO" "$cheev" "$as_ac_var"
if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
ax_lapack_ok=yes
fi
LIBS="$save_LIBS"
fi
# Generic LAPACK library?
for lapack in lapack lapack_rs6k; do
if test $ax_lapack_ok = no; then
save_LIBS="$LIBS"; LIBS="$BLAS_LIBS $LIBS"
as_ac_Lib=`$as_echo "ac_cv_lib_$lapack''_$cheev" | $as_tr_sh`
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $cheev in -l$lapack" >&5
$as_echo_n "checking for $cheev in -l$lapack... " >&6; }
if eval \${$as_ac_Lib+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-l$lapack $FLIBS $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char $cheev ();
#ifdef F77_DUMMY_MAIN
# ifdef __cplusplus
extern "C"
# endif
int F77_DUMMY_MAIN() { return 1; }
#endif
int
main ()
{
return $cheev ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
eval "$as_ac_Lib=yes"
else
eval "$as_ac_Lib=no"
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
eval ac_res=\$$as_ac_Lib
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then :
ax_lapack_ok=yes; LAPACK_LIBS="-l$lapack"
fi
LIBS="$save_LIBS"
fi
done
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x"$ax_lapack_ok" = xyes; then
$as_echo "#define HAVE_LAPACK 1" >>confdefs.h
:
else
ax_lapack_ok=no
fi
if test "$ax_lapack_ok" = "no"; then
as_fn_error $? "Cannot find LAPACK libraries" "$LINENO" 5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI mode" >&5
$as_echo_n "checking for MPI mode... " >&6; }
# Check whether --enable-mpi was given.
if test "${enable_mpi+set}" = set; then :
enableval=$enable_mpi; enable_mpi=$enableval
else
enable_mpi=no
fi
if test x"$enable_mpi" != x"no"; then
ac_ext=f
ac_compile='$F77 -c $FFLAGS conftest.$ac_ext >&5'
ac_link='$F77 -o conftest$ac_exeext $FFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_f77_compiler_gnu
for ac_prog in mpif77 hf77 mpxlf_r mpxlf mpf77 cmpifc
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_MPIF77+:} false; then :
$as_echo_n "(cached) " >&6
else
if test -n "$MPIF77"; then
ac_cv_prog_MPIF77="$MPIF77" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_MPIF77="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
IFS=$as_save_IFS
fi
fi
MPIF77=$ac_cv_prog_MPIF77
if test -n "$MPIF77"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MPIF77" >&5
$as_echo "$MPIF77" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
test -n "$MPIF77" && break
done
test -n "$MPIF77" || MPIF77="$F77"
ax_mpi_save_F77="$F77"
F77="$MPIF77"
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init" >&5
$as_echo_n "checking for MPI_Init... " >&6; }
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
MPILIBS=""
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
fi
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lfmpi" >&5
$as_echo_n "checking for MPI_Init in -lfmpi... " >&6; }
if ${ac_cv_lib_fmpi_MPI_Init+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lfmpi $LIBS"
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
ac_cv_lib_fmpi_MPI_Init=yes
else
ac_cv_lib_fmpi_MPI_Init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fmpi_MPI_Init" >&5
$as_echo "$ac_cv_lib_fmpi_MPI_Init" >&6; }
if test "x$ac_cv_lib_fmpi_MPI_Init" = xyes; then :
MPILIBS="-lfmpi"
fi
fi
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lfmpich" >&5
$as_echo_n "checking for MPI_Init in -lfmpich... " >&6; }
if ${ac_cv_lib_fmpich_MPI_Init+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lfmpich $LIBS"
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
ac_cv_lib_fmpich_MPI_Init=yes
else
ac_cv_lib_fmpich_MPI_Init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_fmpich_MPI_Init" >&5
$as_echo "$ac_cv_lib_fmpich_MPI_Init" >&6; }
if test "x$ac_cv_lib_fmpich_MPI_Init" = xyes; then :
MPILIBS="-lfmpich"
fi
fi
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpif77" >&5
$as_echo_n "checking for MPI_Init in -lmpif77... " >&6; }
if ${ac_cv_lib_mpif77_MPI_Init+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lmpif77 $LIBS"
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
ac_cv_lib_mpif77_MPI_Init=yes
else
ac_cv_lib_mpif77_MPI_Init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpif77_MPI_Init" >&5
$as_echo "$ac_cv_lib_mpif77_MPI_Init" >&6; }
if test "x$ac_cv_lib_mpif77_MPI_Init" = xyes; then :
MPILIBS="-lmpif77"
fi
fi
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpi" >&5
$as_echo_n "checking for MPI_Init in -lmpi... " >&6; }
if ${ac_cv_lib_mpi_MPI_Init+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lmpi $LIBS"
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
ac_cv_lib_mpi_MPI_Init=yes
else
ac_cv_lib_mpi_MPI_Init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpi_MPI_Init" >&5
$as_echo "$ac_cv_lib_mpi_MPI_Init" >&6; }
if test "x$ac_cv_lib_mpi_MPI_Init" = xyes; then :
MPILIBS="-lmpi"
fi
fi
if test x = x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for MPI_Init in -lmpich" >&5
$as_echo_n "checking for MPI_Init in -lmpich... " >&6; }
if ${ac_cv_lib_mpich_MPI_Init+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lmpich $LIBS"
cat > conftest.$ac_ext <<_ACEOF
program main
call MPI_Init
end
_ACEOF
if ac_fn_f77_try_link "$LINENO"; then :
ac_cv_lib_mpich_MPI_Init=yes
else
ac_cv_lib_mpich_MPI_Init=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mpich_MPI_Init" >&5
$as_echo "$ac_cv_lib_mpich_MPI_Init" >&6; }
if test "x$ac_cv_lib_mpich_MPI_Init" = xyes; then :
MPILIBS="-lmpich"
fi
fi
if test x != x"$MPILIBS"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mpif.h" >&5
$as_echo_n "checking for mpif.h... " >&6; }
cat > conftest.$ac_ext <<_ACEOF
program main
include 'mpif.h'
end
_ACEOF
if ac_fn_f77_try_compile "$LINENO"; then :
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
else
MPILIBS=""
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
F77="$ax_mpi_save_F77"
# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND:
if test x = x"$MPILIBS"; then
as_fn_error $? "could not compile a MPI test program" "$LINENO" 5
:
else
$as_echo "#define HAVE_MPI 1" >>confdefs.h
:
fi
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
fi
if test x"$enable_mpi" = x"yes"; then
MPI_TRUE=
MPI_FALSE='#'
else
MPI_TRUE='#'
MPI_FALSE=
fi
# LAPACK/Makefile
ac_config_files="$ac_config_files arpack.pc Makefile SRC/Makefile UTIL/Makefile TESTS/Makefile EXAMPLES/Makefile EXAMPLES/BAND/Makefile EXAMPLES/COMPLEX/Makefile EXAMPLES/NONSYM/Makefile EXAMPLES/SIMPLE/Makefile EXAMPLES/SVD/Makefile EXAMPLES/SYM/Makefile PARPACK/Makefile PARPACK/SRC/Makefile PARPACK/SRC/MPI/Makefile PARPACK/UTIL/Makefile PARPACK/UTIL/MPI/Makefile PARPACK/UTIL/BLACS/Makefile PARPACK/EXAMPLES/MPI/Makefile PARPACK/EXAMPLES/BLACS/Makefile PARPACK/SRC/BLACS/Makefile"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems. If it contains results you don't
# want to keep, you may remove or edit it.
#
# config.status only pays attention to the cache file if you give it
# the --recheck option to rerun configure.
#
# `ac_cv_env_foo' variables (set or unset) will be overridden when
# loading this file, other *unset* `ac_cv_foo' will be assigned the
# following values.
_ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(
for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
eval ac_val=\$$ac_var
case $ac_val in #(
*${as_nl}*)
case $ac_var in #(
*_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
esac
case $ac_var in #(
_ | IFS | as_nl) ;; #(
BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
*) { eval $ac_var=; unset $ac_var;} ;;
esac ;;
esac
done
(set) 2>&1 |
case $as_nl`(ac_space=' '; set) 2>&1` in #(
*${as_nl}ac_space=\ *)
# `set' does not quote correctly, so add quotes: double-quote
# substitution turns \\\\ into \\, and sed turns \\ into \.
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
;; #(
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
esac |
sort
) |
sed '
/^ac_cv_env_/b end
t clear
:clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
:end' >>confcache
if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
if test -w "$cache_file"; then
if test "x$cache_file" != "x/dev/null"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$as_me: updating cache $cache_file" >&6;}
if test ! -f "$cache_file" || test -h "$cache_file"; then
cat confcache >"$cache_file"
else
case $cache_file in #(
*/* | ?:*)
mv -f confcache "$cache_file"$$ &&
mv -f "$cache_file"$$ "$cache_file" ;; #(
*)
mv -f confcache "$cache_file" ;;
esac
fi
fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
# take arguments), then branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
ac_script='
:mline
/\\$/{
N
s,\\\n,,
b mline
}
t clear
:clear
s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
t quote
s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
t quote
b any
:quote
s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
s/\[/\\&/g
s/\]/\\&/g
s/\$/$$/g
H
:any
${
g
s/^\n//
s/\n/ /g
p
}
'
DEFS=`sed -n "$ac_script" confdefs.h`
ac_libobjs=
ac_ltlibobjs=
U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
# 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
# will be set to the directory where LIBOBJS objects are built.
as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
LTLIBOBJS=$ac_ltlibobjs
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5
$as_echo_n "checking that generated files are newer than configure... " >&6; }
if test -n "$am_sleep_pid"; then
# Hide warnings about reused PIDs.
wait $am_sleep_pid 2>/dev/null
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5
$as_echo "done" >&6; }
if test -n "$EXEEXT"; then
am__EXEEXT_TRUE=
am__EXEEXT_FALSE='#'
else
am__EXEEXT_TRUE='#'
am__EXEEXT_FALSE=
fi
if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then
as_fn_error $? "conditional \"MAINTAINER_MODE\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then
as_fn_error $? "conditional \"AMDEP\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then
as_fn_error $? "conditional \"am__fastdepCC\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
if test -z "${MPI_TRUE}" && test -z "${MPI_FALSE}"; then
as_fn_error $? "conditional \"MPI\" was never defined.
Usually this means the macro was only invoked conditionally." "$LINENO" 5
fi
: "${CONFIG_STATUS=./config.status}"
ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
as_write_fail=0
cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
# Compiler output produced by configure, useful for debugging
# configure, is in config.log if it exists.
debug=false
ac_cs_recheck=false
ac_cs_silent=false
SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
# Be more Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
# Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
setopt NO_GLOB_SUBST
else
case `(set -o) 2>/dev/null` in #(
*posix*) :
set -o posix ;; #(
*) :
;;
esac
fi
as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
&& (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
as_echo='print -r --'
as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
as_echo='printf %s\n'
as_echo_n='printf %s'
else
if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
as_echo_n='/usr/ucb/echo -n'
else
as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
as_echo_n_body='eval
arg=$1;
case $arg in #(
*"$as_nl"*)
expr "X$arg" : "X\\(.*\\)$as_nl";
arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
esac;
expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
'
export as_echo_n_body
as_echo_n='sh -c $as_echo_n_body as_echo'
fi
export as_echo_body
as_echo='sh -c $as_echo_body as_echo'
fi
# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
PATH_SEPARATOR=:
(PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
(PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
PATH_SEPARATOR=';'
}
fi
# IFS
# We need space, tab and new line, in precisely that order. Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" "" $as_nl"
# Find who we are. Look in the path if we contain no directory separator.
as_myself=
case $0 in #((
*[\\/]* ) as_myself=$0 ;;
*) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done
IFS=$as_save_IFS
;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
as_myself=$0
fi
if test ! -f "$as_myself"; then
$as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
exit 1
fi
# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
# suppresses any "Segmentation fault" message there. '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
&& ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
as_status=$1; test $as_status -eq 0 && as_status=1
if test "$4"; then
as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
$as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
fi
$as_echo "$as_me: error: $2" >&2
as_fn_exit $as_status
} # as_fn_error
# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
return $1
} # as_fn_set_status
# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
set +e
as_fn_set_status $1
exit $1
} # as_fn_exit
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
{ eval $1=; unset $1;}
}
as_unset=as_fn_unset
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
eval 'as_fn_append ()
{
eval $1+=\$2
}'
else
as_fn_append ()
{
eval $1=\$$1\$2
}
fi # as_fn_append
# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
eval 'as_fn_arith ()
{
as_val=$(( $* ))
}'
else
as_fn_arith ()
{
as_val=`expr "$@" || test $? -eq 1`
}
fi # as_fn_arith
if expr a : '\(a\)' >/dev/null 2>&1 &&
test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
as_dirname=dirname
else
as_dirname=false
fi
as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
sed '/^.*\/\([^/][^/]*\)\/*$/{
s//\1/
q
}
/^X\/\(\/\/\)$/{
s//\1/
q
}
/^X\/\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
-n*)
case `echo 'xy\c'` in
*c*) ECHO_T=' ';; # ECHO_T is single tab character.
xy) ECHO_C='\c';;
*) echo `echo ksh88 bug on AIX 6.1` > /dev/null
ECHO_T=' ';;
esac;;
*)
ECHO_N='-n';;
esac
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
rm -f conf$$.dir/conf$$.file
else
rm -f conf$$.dir
mkdir conf$$.dir 2>/dev/null
fi
if (echo >conf$$.file) 2>/dev/null; then
if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
# In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -pR'
fi
else
as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{
case $as_dir in #(
-*) as_dir=./$as_dir;;
esac
test -d "$as_dir" || eval $as_mkdir_p || {
as_dirs=
while :; do
case $as_dir in #(
*\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
*) as_qdir=$as_dir;;
esac
as_dirs="'$as_qdir' $as_dirs"
as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$as_dir" : 'X\(//\)[^/]' \| \
X"$as_dir" : 'X\(//\)$' \| \
X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
test -d "$as_dir" && break
done
test -z "$as_dirs" || eval "mkdir $as_dirs"
} || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
exec 6>&1
## ----------------------------------- ##
## Main body of $CONFIG_STATUS script. ##
## ----------------------------------- ##
_ASEOF
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by arpack-ng $as_me 3.1.5, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
CONFIG_LINKS = $CONFIG_LINKS
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
on `(hostname || uname -n) 2>/dev/null | sed 1q`
"
_ACEOF
case $ac_config_files in *"
"*) set x $ac_config_files; shift; ac_config_files=$*;;
esac
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
# Files that config.status was made for.
config_files="$ac_config_files"
config_commands="$ac_config_commands"
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
\`$as_me' instantiates files and other configuration actions
from templates according to the current configuration. Unless the files
and actions are specified as TAGs, all are instantiated by default.
Usage: $0 [OPTION]... [TAG]...
-h, --help print this help, then exit
-V, --version print version number and configuration settings, then exit
--config print configuration, then exit
-q, --quiet, --silent
do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
--file=FILE[:TEMPLATE]
instantiate the configuration file FILE
Configuration files:
$config_files
Configuration commands:
$config_commands
Report bugs to ."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
arpack-ng config.status 3.1.5
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
ac_pwd='$ac_pwd'
srcdir='$srcdir'
INSTALL='$INSTALL'
MKDIR_P='$MKDIR_P'
AWK='$AWK'
test -n "\$AWK" || AWK=awk
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
case $1 in
--*=?*)
ac_option=`expr "X$1" : 'X\([^=]*\)='`
ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
ac_shift=:
;;
--*=)
ac_option=`expr "X$1" : 'X\([^=]*\)='`
ac_optarg=
ac_shift=:
;;
*)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
esac
case $ac_option in
# Handling of the options.
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
--version | --versio | --versi | --vers | --ver | --ve | --v | -V )
$as_echo "$ac_cs_version"; exit ;;
--config | --confi | --conf | --con | --co | --c )
$as_echo "$ac_cs_config"; exit ;;
--debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
case $ac_optarg in
*\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
'') as_fn_error $? "missing file argument" ;;
esac
as_fn_append CONFIG_FILES " '$ac_optarg'"
ac_need_defaults=false;;
--he | --h | --help | --hel | -h )
$as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
-*) as_fn_error $? "unrecognized option: \`$1'
Try \`$0 --help' for more information." ;;
*) as_fn_append ac_config_targets " $1"
ac_need_defaults=false ;;
esac
shift
done
ac_configure_extra_args=
if $ac_cs_silent; then
exec 6>/dev/null
ac_configure_extra_args="$ac_configure_extra_args --silent"
fi
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
shift
\$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
CONFIG_SHELL='$SHELL'
export CONFIG_SHELL
exec "\$@"
fi
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
exec 5>>config.log
{
echo
sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
$as_echo "$ac_log"
} >&5
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
#
# INIT-COMMANDS
#
AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"
# The HP-UX ksh and POSIX shell print the target directory to stdout
# if CDPATH is set.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
sed_quote_subst='$sed_quote_subst'
double_quote_subst='$double_quote_subst'
delay_variable_subst='$delay_variable_subst'
macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`'
macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`'
AS='`$ECHO "$AS" | $SED "$delay_single_quote_subst"`'
DLLTOOL='`$ECHO "$DLLTOOL" | $SED "$delay_single_quote_subst"`'
OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`'
enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`'
enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`'
pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`'
enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`'
SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`'
ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`'
PATH_SEPARATOR='`$ECHO "$PATH_SEPARATOR" | $SED "$delay_single_quote_subst"`'
host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`'
host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`'
host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`'
build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`'
build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`'
build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`'
SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`'
Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`'
GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`'
EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`'
FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`'
LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`'
NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`'
LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`'
max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`'
ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`'
exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`'
lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`'
lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`'
lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`'
lt_cv_to_host_file_cmd='`$ECHO "$lt_cv_to_host_file_cmd" | $SED "$delay_single_quote_subst"`'
lt_cv_to_tool_file_cmd='`$ECHO "$lt_cv_to_tool_file_cmd" | $SED "$delay_single_quote_subst"`'
reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`'
reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`'
deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`'
file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`'
file_magic_glob='`$ECHO "$file_magic_glob" | $SED "$delay_single_quote_subst"`'
want_nocaseglob='`$ECHO "$want_nocaseglob" | $SED "$delay_single_quote_subst"`'
sharedlib_from_linklib_cmd='`$ECHO "$sharedlib_from_linklib_cmd" | $SED "$delay_single_quote_subst"`'
AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`'
AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`'
archiver_list_spec='`$ECHO "$archiver_list_spec" | $SED "$delay_single_quote_subst"`'
STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`'
RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`'
old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`'
old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`'
lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`'
CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`'
CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`'
compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`'
GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`'
lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`'
lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`'
lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`'
lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`'
nm_file_list_spec='`$ECHO "$nm_file_list_spec" | $SED "$delay_single_quote_subst"`'
lt_sysroot='`$ECHO "$lt_sysroot" | $SED "$delay_single_quote_subst"`'
objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`'
MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`'
lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`'
need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`'
MANIFEST_TOOL='`$ECHO "$MANIFEST_TOOL" | $SED "$delay_single_quote_subst"`'
DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`'
NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`'
LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`'
OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`'
OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`'
libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`'
shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`'
extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`'
enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`'
export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`'
whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`'
compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`'
old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`'
old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`'
archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`'
archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`'
module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`'
module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`'
with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`'
allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`'
no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`'
hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`'
hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`'
hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`'
hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`'
hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`'
hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`'
hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`'
inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`'
link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`'
always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`'
export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`'
exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`'
include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`'
prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`'
postlink_cmds='`$ECHO "$postlink_cmds" | $SED "$delay_single_quote_subst"`'
file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`'
variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`'
need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`'
need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`'
version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`'
runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`'
shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`'
shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`'
libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`'
library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`'
soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`'
install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`'
postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`'
postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`'
finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`'
finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`'
hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`'
sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`'
sys_lib_dlsearch_path_spec='`$ECHO "$sys_lib_dlsearch_path_spec" | $SED "$delay_single_quote_subst"`'
hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`'
enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`'
enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`'
enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`'
old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`'
striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`'
LD_F77='`$ECHO "$LD_F77" | $SED "$delay_single_quote_subst"`'
reload_flag_F77='`$ECHO "$reload_flag_F77" | $SED "$delay_single_quote_subst"`'
reload_cmds_F77='`$ECHO "$reload_cmds_F77" | $SED "$delay_single_quote_subst"`'
old_archive_cmds_F77='`$ECHO "$old_archive_cmds_F77" | $SED "$delay_single_quote_subst"`'
compiler_F77='`$ECHO "$compiler_F77" | $SED "$delay_single_quote_subst"`'
GCC_F77='`$ECHO "$GCC_F77" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_no_builtin_flag_F77='`$ECHO "$lt_prog_compiler_no_builtin_flag_F77" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_pic_F77='`$ECHO "$lt_prog_compiler_pic_F77" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_wl_F77='`$ECHO "$lt_prog_compiler_wl_F77" | $SED "$delay_single_quote_subst"`'
lt_prog_compiler_static_F77='`$ECHO "$lt_prog_compiler_static_F77" | $SED "$delay_single_quote_subst"`'
lt_cv_prog_compiler_c_o_F77='`$ECHO "$lt_cv_prog_compiler_c_o_F77" | $SED "$delay_single_quote_subst"`'
archive_cmds_need_lc_F77='`$ECHO "$archive_cmds_need_lc_F77" | $SED "$delay_single_quote_subst"`'
enable_shared_with_static_runtimes_F77='`$ECHO "$enable_shared_with_static_runtimes_F77" | $SED "$delay_single_quote_subst"`'
export_dynamic_flag_spec_F77='`$ECHO "$export_dynamic_flag_spec_F77" | $SED "$delay_single_quote_subst"`'
whole_archive_flag_spec_F77='`$ECHO "$whole_archive_flag_spec_F77" | $SED "$delay_single_quote_subst"`'
compiler_needs_object_F77='`$ECHO "$compiler_needs_object_F77" | $SED "$delay_single_quote_subst"`'
old_archive_from_new_cmds_F77='`$ECHO "$old_archive_from_new_cmds_F77" | $SED "$delay_single_quote_subst"`'
old_archive_from_expsyms_cmds_F77='`$ECHO "$old_archive_from_expsyms_cmds_F77" | $SED "$delay_single_quote_subst"`'
archive_cmds_F77='`$ECHO "$archive_cmds_F77" | $SED "$delay_single_quote_subst"`'
archive_expsym_cmds_F77='`$ECHO "$archive_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`'
module_cmds_F77='`$ECHO "$module_cmds_F77" | $SED "$delay_single_quote_subst"`'
module_expsym_cmds_F77='`$ECHO "$module_expsym_cmds_F77" | $SED "$delay_single_quote_subst"`'
with_gnu_ld_F77='`$ECHO "$with_gnu_ld_F77" | $SED "$delay_single_quote_subst"`'
allow_undefined_flag_F77='`$ECHO "$allow_undefined_flag_F77" | $SED "$delay_single_quote_subst"`'
no_undefined_flag_F77='`$ECHO "$no_undefined_flag_F77" | $SED "$delay_single_quote_subst"`'
hardcode_libdir_flag_spec_F77='`$ECHO "$hardcode_libdir_flag_spec_F77" | $SED "$delay_single_quote_subst"`'
hardcode_libdir_separator_F77='`$ECHO "$hardcode_libdir_separator_F77" | $SED "$delay_single_quote_subst"`'
hardcode_direct_F77='`$ECHO "$hardcode_direct_F77" | $SED "$delay_single_quote_subst"`'
hardcode_direct_absolute_F77='`$ECHO "$hardcode_direct_absolute_F77" | $SED "$delay_single_quote_subst"`'
hardcode_minus_L_F77='`$ECHO "$hardcode_minus_L_F77" | $SED "$delay_single_quote_subst"`'
hardcode_shlibpath_var_F77='`$ECHO "$hardcode_shlibpath_var_F77" | $SED "$delay_single_quote_subst"`'
hardcode_automatic_F77='`$ECHO "$hardcode_automatic_F77" | $SED "$delay_single_quote_subst"`'
inherit_rpath_F77='`$ECHO "$inherit_rpath_F77" | $SED "$delay_single_quote_subst"`'
link_all_deplibs_F77='`$ECHO "$link_all_deplibs_F77" | $SED "$delay_single_quote_subst"`'
always_export_symbols_F77='`$ECHO "$always_export_symbols_F77" | $SED "$delay_single_quote_subst"`'
export_symbols_cmds_F77='`$ECHO "$export_symbols_cmds_F77" | $SED "$delay_single_quote_subst"`'
exclude_expsyms_F77='`$ECHO "$exclude_expsyms_F77" | $SED "$delay_single_quote_subst"`'
include_expsyms_F77='`$ECHO "$include_expsyms_F77" | $SED "$delay_single_quote_subst"`'
prelink_cmds_F77='`$ECHO "$prelink_cmds_F77" | $SED "$delay_single_quote_subst"`'
postlink_cmds_F77='`$ECHO "$postlink_cmds_F77" | $SED "$delay_single_quote_subst"`'
file_list_spec_F77='`$ECHO "$file_list_spec_F77" | $SED "$delay_single_quote_subst"`'
hardcode_action_F77='`$ECHO "$hardcode_action_F77" | $SED "$delay_single_quote_subst"`'
LTCC='$LTCC'
LTCFLAGS='$LTCFLAGS'
compiler='$compiler_DEFAULT'
# A function that is used when there is no print builtin or printf.
func_fallback_echo ()
{
eval 'cat <<_LTECHO_EOF
\$1
_LTECHO_EOF'
}
# Quote evaled strings.
for var in AS \
DLLTOOL \
OBJDUMP \
SHELL \
ECHO \
PATH_SEPARATOR \
SED \
GREP \
EGREP \
FGREP \
LD \
NM \
LN_S \
lt_SP2NL \
lt_NL2SP \
reload_flag \
deplibs_check_method \
file_magic_cmd \
file_magic_glob \
want_nocaseglob \
sharedlib_from_linklib_cmd \
AR \
AR_FLAGS \
archiver_list_spec \
STRIP \
RANLIB \
CC \
CFLAGS \
compiler \
lt_cv_sys_global_symbol_pipe \
lt_cv_sys_global_symbol_to_cdecl \
lt_cv_sys_global_symbol_to_c_name_address \
lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \
nm_file_list_spec \
lt_prog_compiler_no_builtin_flag \
lt_prog_compiler_pic \
lt_prog_compiler_wl \
lt_prog_compiler_static \
lt_cv_prog_compiler_c_o \
need_locks \
MANIFEST_TOOL \
DSYMUTIL \
NMEDIT \
LIPO \
OTOOL \
OTOOL64 \
shrext_cmds \
export_dynamic_flag_spec \
whole_archive_flag_spec \
compiler_needs_object \
with_gnu_ld \
allow_undefined_flag \
no_undefined_flag \
hardcode_libdir_flag_spec \
hardcode_libdir_separator \
exclude_expsyms \
include_expsyms \
file_list_spec \
variables_saved_for_relink \
libname_spec \
library_names_spec \
soname_spec \
install_override_mode \
finish_eval \
old_striplib \
striplib \
LD_F77 \
reload_flag_F77 \
compiler_F77 \
lt_prog_compiler_no_builtin_flag_F77 \
lt_prog_compiler_pic_F77 \
lt_prog_compiler_wl_F77 \
lt_prog_compiler_static_F77 \
lt_cv_prog_compiler_c_o_F77 \
export_dynamic_flag_spec_F77 \
whole_archive_flag_spec_F77 \
compiler_needs_object_F77 \
with_gnu_ld_F77 \
allow_undefined_flag_F77 \
no_undefined_flag_F77 \
hardcode_libdir_flag_spec_F77 \
hardcode_libdir_separator_F77 \
exclude_expsyms_F77 \
include_expsyms_F77 \
file_list_spec_F77; do
case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
*[\\\\\\\`\\"\\\$]*)
eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\""
;;
*)
eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
;;
esac
done
# Double-quote double-evaled strings.
for var in reload_cmds \
old_postinstall_cmds \
old_postuninstall_cmds \
old_archive_cmds \
extract_expsyms_cmds \
old_archive_from_new_cmds \
old_archive_from_expsyms_cmds \
archive_cmds \
archive_expsym_cmds \
module_cmds \
module_expsym_cmds \
export_symbols_cmds \
prelink_cmds \
postlink_cmds \
postinstall_cmds \
postuninstall_cmds \
finish_cmds \
sys_lib_search_path_spec \
sys_lib_dlsearch_path_spec \
reload_cmds_F77 \
old_archive_cmds_F77 \
old_archive_from_new_cmds_F77 \
old_archive_from_expsyms_cmds_F77 \
archive_cmds_F77 \
archive_expsym_cmds_F77 \
module_cmds_F77 \
module_expsym_cmds_F77 \
export_symbols_cmds_F77 \
prelink_cmds_F77 \
postlink_cmds_F77; do
case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in
*[\\\\\\\`\\"\\\$]*)
eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\""
;;
*)
eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\""
;;
esac
done
ac_aux_dir='$ac_aux_dir'
xsi_shell='$xsi_shell'
lt_shell_append='$lt_shell_append'
# See if we are running on zsh, and set the options which allow our
# commands through without removal of \ escapes INIT.
if test -n "\${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
PACKAGE='$PACKAGE'
VERSION='$VERSION'
TIMESTAMP='$TIMESTAMP'
RM='$RM'
ofile='$ofile'
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Handling of arguments.
for ac_config_target in $ac_config_targets
do
case $ac_config_target in
"depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;;
"libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;;
"arpack.pc") CONFIG_FILES="$CONFIG_FILES arpack.pc" ;;
"Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
"SRC/Makefile") CONFIG_FILES="$CONFIG_FILES SRC/Makefile" ;;
"UTIL/Makefile") CONFIG_FILES="$CONFIG_FILES UTIL/Makefile" ;;
"TESTS/Makefile") CONFIG_FILES="$CONFIG_FILES TESTS/Makefile" ;;
"EXAMPLES/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/Makefile" ;;
"EXAMPLES/BAND/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/BAND/Makefile" ;;
"EXAMPLES/COMPLEX/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/COMPLEX/Makefile" ;;
"EXAMPLES/NONSYM/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/NONSYM/Makefile" ;;
"EXAMPLES/SIMPLE/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/SIMPLE/Makefile" ;;
"EXAMPLES/SVD/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/SVD/Makefile" ;;
"EXAMPLES/SYM/Makefile") CONFIG_FILES="$CONFIG_FILES EXAMPLES/SYM/Makefile" ;;
"PARPACK/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/Makefile" ;;
"PARPACK/SRC/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/SRC/Makefile" ;;
"PARPACK/SRC/MPI/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/SRC/MPI/Makefile" ;;
"PARPACK/UTIL/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/UTIL/Makefile" ;;
"PARPACK/UTIL/MPI/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/UTIL/MPI/Makefile" ;;
"PARPACK/UTIL/BLACS/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/UTIL/BLACS/Makefile" ;;
"PARPACK/EXAMPLES/MPI/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/EXAMPLES/MPI/Makefile" ;;
"PARPACK/EXAMPLES/BLACS/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/EXAMPLES/BLACS/Makefile" ;;
"PARPACK/SRC/BLACS/Makefile") CONFIG_FILES="$CONFIG_FILES PARPACK/SRC/BLACS/Makefile" ;;
*) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
done
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
# bizarre bug on SunOS 4.1.3.
if $ac_need_defaults; then
test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
fi
# Have a temporary directory for convenience. Make it in the build tree
# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
# Hook for its removal unless debugging.
# Note that there is a small window in which the directory will not be cleaned:
# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
tmp= ac_tmp=
trap 'exit_status=$?
: "${ac_tmp:=$tmp}"
{ test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
' 0
trap 'as_fn_exit 1' 1 2 13 15
}
# Create a (secure) tmp directory for tmp files.
{
tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
test -d "$tmp"
} ||
{
tmp=./conf$$-$RANDOM
(umask 077 && mkdir "$tmp")
} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
ac_tmp=$tmp
# Set up the scripts for CONFIG_FILES section.
# No need to generate them if there are no CONFIG_FILES.
# This happens for instance with `./config.status config.h'.
if test -n "$CONFIG_FILES"; then
ac_cr=`echo X | tr X '\015'`
# On cygwin, bash can eat \r inside `` if the user requested igncr.
# But we know of no other shell where ac_cr would be empty at this
# point, so we can use a bashism as a fallback.
if test "x$ac_cr" = x; then
eval ac_cr=\$\'\\r\'
fi
ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null`
if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
ac_cs_awk_cr='\\r'
else
ac_cs_awk_cr=$ac_cr
fi
echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
_ACEOF
{
echo "cat >conf$$subs.awk <<_ACEOF" &&
echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
echo "_ACEOF"
} >conf$$subs.sh ||
as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
. ./conf$$subs.sh ||
as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
if test $ac_delim_n = $ac_delim_num; then
break
elif $ac_last_try; then
as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
else
ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
fi
done
rm -f conf$$subs.sh
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
_ACEOF
sed -n '
h
s/^/S["/; s/!.*/"]=/
p
g
s/^[^!]*!//
:repl
t repl
s/'"$ac_delim"'$//
t delim
:nl
h
s/\(.\{148\}\)..*/\1/
t more1
s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
p
n
b repl
:more1
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t nl
:delim
h
s/\(.\{148\}\)..*/\1/
t more2
s/["\\]/\\&/g; s/^/"/; s/$/"/
p
b
:more2
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t delim
' >$CONFIG_STATUS || ac_write_fail=1
rm -f conf$$subs.awk
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACAWK
cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
for (key in S) S_is_set[key] = 1
FS = ""
}
{
line = $ 0
nfields = split(line, field, "@")
substed = 0
len = length(field[1])
for (i = 2; i < nfields; i++) {
key = field[i]
keylen = length(key)
if (S_is_set[key]) {
value = S[key]
line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
len += length(value) + length(field[++i])
substed = 1
} else
len += 1 + keylen
}
print line
}
_ACAWK
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
else
cat
fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
|| as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF
# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{
h
s///
s/^/:/
s/[ ]*$/:/
s/:\$(srcdir):/:/g
s/:\${srcdir}:/:/g
s/:@srcdir@:/:/g
s/^:*//
s/:*$//
x
s/\(=[ ]*\).*/\1/
G
s/\n//
s/^[^=]*=[ ]*$//
}'
fi
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
fi # test -n "$CONFIG_FILES"
eval set X " :F $CONFIG_FILES :C $CONFIG_COMMANDS"
shift
for ac_tag
do
case $ac_tag in
:[FHLC]) ac_mode=$ac_tag; continue;;
esac
case $ac_mode$ac_tag in
:[FHL]*:*);;
:L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
:[FH]-) ac_tag=-:-;;
:[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
esac
ac_save_IFS=$IFS
IFS=:
set x $ac_tag
IFS=$ac_save_IFS
shift
ac_file=$1
shift
case $ac_mode in
:L) ac_source=$1;;
:[FH])
ac_file_inputs=
for ac_f
do
case $ac_f in
-) ac_f="$ac_tmp/stdin";;
*) # Look for the file first in the build tree, then in the source tree
# (if the path is not absolute). The absolute path cannot be DOS-style,
# because $ac_f cannot contain `:'.
test -f "$ac_f" ||
case $ac_f in
[\\/$]*) false;;
*) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
esac ||
as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
esac
case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
as_fn_append ac_file_inputs " '$ac_f'"
done
# Let's still pretend it is `configure' which instantiates (i.e., don't
# use $as_me), people would be surprised to read:
# /* config.h. Generated by config.status. */
configure_input='Generated from '`
$as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
`' by configure.'
if test x"$ac_file" != x-; then
configure_input="$ac_file. $configure_input"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
fi
# Neutralize special characters interpreted by sed in replacement strings.
case $configure_input in #(
*\&* | *\|* | *\\* )
ac_sed_conf_input=`$as_echo "$configure_input" |
sed 's/[\\\\&|]/\\\\&/g'`;; #(
*) ac_sed_conf_input=$configure_input;;
esac
case $ac_tag in
*:-:* | *:-) cat >"$ac_tmp/stdin" \
|| as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
esac
;;
esac
ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$ac_file" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
as_dir="$ac_dir"; as_fn_mkdir_p
ac_builddir=.
case "$ac_dir" in
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
# A ".." for each directory in $ac_dir_suffix.
ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
case $ac_top_builddir_sub in
"") ac_top_builddir_sub=. ac_top_build_prefix= ;;
*) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
esac ;;
esac
ac_abs_top_builddir=$ac_pwd
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
case $srcdir in
.) # We are building in place.
ac_srcdir=.
ac_top_srcdir=$ac_top_builddir_sub
ac_abs_top_srcdir=$ac_pwd ;;
[\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
ac_top_srcdir=$srcdir
ac_abs_top_srcdir=$srcdir ;;
*) # Relative name.
ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
ac_top_srcdir=$ac_top_build_prefix$srcdir
ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
case $ac_mode in
:F)
#
# CONFIG_FILE
#
case $INSTALL in
[\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
*) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
esac
ac_MKDIR_P=$MKDIR_P
case $MKDIR_P in
[\\/$]* | ?:[\\/]* ) ;;
*/*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;;
esac
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
ac_sed_dataroot='
/datarootdir/ {
p
q
}
/@datadir@/p
/@docdir@/p
/@infodir@/p
/@localedir@/p
/@mandir@/p'
case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_datarootdir_hack='
s&@datadir@&$datadir&g
s&@docdir@&$docdir&g
s&@infodir@&$infodir&g
s&@localedir@&$localedir&g
s&@mandir@&$mandir&g
s&\\\${datarootdir}&$datarootdir&g' ;;
esac
_ACEOF
# Neutralize VPATH when `$srcdir' = `.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
s|@configure_input@|$ac_sed_conf_input|;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
s&@INSTALL@&$ac_INSTALL&;t t
s&@MKDIR_P@&$ac_MKDIR_P&;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
>$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
{ ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
{ ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \
"$ac_tmp/out"`; test -z "$ac_out"; } &&
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined. Please make sure it is defined" >&5
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined. Please make sure it is defined" >&2;}
rm -f "$ac_tmp/stdin"
case $ac_file in
-) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
*) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
esac \
|| as_fn_error $? "could not create $ac_file" "$LINENO" 5
;;
:C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
$as_echo "$as_me: executing $ac_file commands" >&6;}
;;
esac
case $ac_file$ac_mode in
"depfiles":C) test x"$AMDEP_TRUE" != x"" || {
# Older Autoconf quotes --file arguments for eval, but not when files
# are listed without --file. Let's play safe and only enable the eval
# if we detect the quoting.
case $CONFIG_FILES in
*\'*) eval set x "$CONFIG_FILES" ;;
*) set x $CONFIG_FILES ;;
esac
shift
for mf
do
# Strip MF so we end up with the name of the file.
mf=`echo "$mf" | sed -e 's/:.*$//'`
# Check whether this is an Automake generated Makefile or not.
# We used to match only the files named 'Makefile.in', but
# some people rename them; so instead we look at the file content.
# Grep'ing the first line is not enough: some people post-process
# each Makefile.in and add a new line on top of each file to say so.
# Grep'ing the whole file is not good either: AIX grep has a line
# limit of 2048, but all sed's we know have understand at least 4000.
if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then
dirpart=`$as_dirname -- "$mf" ||
$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$mf" : 'X\(//\)[^/]' \| \
X"$mf" : 'X\(//\)$' \| \
X"$mf" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$mf" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
else
continue
fi
# Extract the definition of DEPDIR, am__include, and am__quote
# from the Makefile without running 'make'.
DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"`
test -z "$DEPDIR" && continue
am__include=`sed -n 's/^am__include = //p' < "$mf"`
test -z "$am__include" && continue
am__quote=`sed -n 's/^am__quote = //p' < "$mf"`
# Find all dependency output files, they are included files with
# $(DEPDIR) in their names. We invoke sed twice because it is the
# simplest approach to changing $(DEPDIR) to its actual value in the
# expansion.
for file in `sed -n "
s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \
sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do
# Make sure the directory exists.
test -f "$dirpart/$file" && continue
fdir=`$as_dirname -- "$file" ||
$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$file" : 'X\(//\)[^/]' \| \
X"$file" : 'X\(//\)$' \| \
X"$file" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$file" |
sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
s//\1/
q
}
/^X\(\/\/\)[^/].*/{
s//\1/
q
}
/^X\(\/\/\)$/{
s//\1/
q
}
/^X\(\/\).*/{
s//\1/
q
}
s/.*/./; q'`
as_dir=$dirpart/$fdir; as_fn_mkdir_p
# echo "creating $dirpart/$file"
echo '# dummy' > "$dirpart/$file"
done
done
}
;;
"libtool":C)
# See if we are running on zsh, and set the options which allow our
# commands through without removal of \ escapes.
if test -n "${ZSH_VERSION+set}" ; then
setopt NO_GLOB_SUBST
fi
cfgfile="${ofile}T"
trap "$RM \"$cfgfile\"; exit 1" 1 2 15
$RM "$cfgfile"
cat <<_LT_EOF >> "$cfgfile"
#! $SHELL
# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION
# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
# NOTE: Changes made to this file will be lost: look at ltmain.sh.
#
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Free Software
# Foundation, Inc.
# Written by Gordon Matzigkeit, 1996
#
# This file is part of GNU Libtool.
#
# GNU Libtool is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# As a special exception to the GNU General Public License,
# if you distribute this file as part of a program or library that
# is built using GNU Libtool, you may include this file under the
# same distribution terms that you use for the rest of that program.
#
# GNU Libtool is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with GNU Libtool; see the file COPYING. If not, a copy
# can be downloaded from http://www.gnu.org/licenses/gpl.html, or
# obtained by writing to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# The names of the tagged configurations supported by this script.
available_tags="F77 "
# ### BEGIN LIBTOOL CONFIG
# Which release of libtool.m4 was used?
macro_version=$macro_version
macro_revision=$macro_revision
# Assembler program.
AS=$lt_AS
# DLL creation program.
DLLTOOL=$lt_DLLTOOL
# Object dumper program.
OBJDUMP=$lt_OBJDUMP
# Whether or not to build shared libraries.
build_libtool_libs=$enable_shared
# Whether or not to build static libraries.
build_old_libs=$enable_static
# What type of objects to build.
pic_mode=$pic_mode
# Whether or not to optimize for fast installation.
fast_install=$enable_fast_install
# Shell to use when invoking shell scripts.
SHELL=$lt_SHELL
# An echo program that protects backslashes.
ECHO=$lt_ECHO
# The PATH separator for the build system.
PATH_SEPARATOR=$lt_PATH_SEPARATOR
# The host system.
host_alias=$host_alias
host=$host
host_os=$host_os
# The build system.
build_alias=$build_alias
build=$build
build_os=$build_os
# A sed program that does not truncate output.
SED=$lt_SED
# Sed that helps us avoid accidentally triggering echo(1) options like -n.
Xsed="\$SED -e 1s/^X//"
# A grep program that handles long lines.
GREP=$lt_GREP
# An ERE matcher.
EGREP=$lt_EGREP
# A literal string matcher.
FGREP=$lt_FGREP
# A BSD- or MS-compatible name lister.
NM=$lt_NM
# Whether we need soft or hard links.
LN_S=$lt_LN_S
# What is the maximum length of a command?
max_cmd_len=$max_cmd_len
# Object file suffix (normally "o").
objext=$ac_objext
# Executable file suffix (normally "").
exeext=$exeext
# whether the shell understands "unset".
lt_unset=$lt_unset
# turn spaces into newlines.
SP2NL=$lt_lt_SP2NL
# turn newlines into spaces.
NL2SP=$lt_lt_NL2SP
# convert \$build file names to \$host format.
to_host_file_cmd=$lt_cv_to_host_file_cmd
# convert \$build files to toolchain format.
to_tool_file_cmd=$lt_cv_to_tool_file_cmd
# Method to check whether dependent libraries are shared objects.
deplibs_check_method=$lt_deplibs_check_method
# Command to use when deplibs_check_method = "file_magic".
file_magic_cmd=$lt_file_magic_cmd
# How to find potential files when deplibs_check_method = "file_magic".
file_magic_glob=$lt_file_magic_glob
# Find potential files using nocaseglob when deplibs_check_method = "file_magic".
want_nocaseglob=$lt_want_nocaseglob
# Command to associate shared and link libraries.
sharedlib_from_linklib_cmd=$lt_sharedlib_from_linklib_cmd
# The archiver.
AR=$lt_AR
# Flags to create an archive.
AR_FLAGS=$lt_AR_FLAGS
# How to feed a file listing to the archiver.
archiver_list_spec=$lt_archiver_list_spec
# A symbol stripping program.
STRIP=$lt_STRIP
# Commands used to install an old-style archive.
RANLIB=$lt_RANLIB
old_postinstall_cmds=$lt_old_postinstall_cmds
old_postuninstall_cmds=$lt_old_postuninstall_cmds
# Whether to use a lock for old archive extraction.
lock_old_archive_extraction=$lock_old_archive_extraction
# A C compiler.
LTCC=$lt_CC
# LTCC compiler flags.
LTCFLAGS=$lt_CFLAGS
# Take the output of nm and produce a listing of raw symbols and C names.
global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe
# Transform the output of nm in a proper C declaration.
global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl
# Transform the output of nm in a C name address pair.
global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address
# Transform the output of nm in a C name address pair when lib prefix is needed.
global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix
# Specify filename containing input files for \$NM.
nm_file_list_spec=$lt_nm_file_list_spec
# The root where to search for dependent libraries,and in which our libraries should be installed.
lt_sysroot=$lt_sysroot
# The name of the directory that contains temporary libtool files.
objdir=$objdir
# Used to examine libraries when file_magic_cmd begins with "file".
MAGIC_CMD=$MAGIC_CMD
# Must we lock files when doing compilation?
need_locks=$lt_need_locks
# Manifest tool.
MANIFEST_TOOL=$lt_MANIFEST_TOOL
# Tool to manipulate archived DWARF debug symbol files on Mac OS X.
DSYMUTIL=$lt_DSYMUTIL
# Tool to change global to local symbols on Mac OS X.
NMEDIT=$lt_NMEDIT
# Tool to manipulate fat objects and archives on Mac OS X.
LIPO=$lt_LIPO
# ldd/readelf like tool for Mach-O binaries on Mac OS X.
OTOOL=$lt_OTOOL
# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4.
OTOOL64=$lt_OTOOL64
# Old archive suffix (normally "a").
libext=$libext
# Shared library suffix (normally ".so").
shrext_cmds=$lt_shrext_cmds
# The commands to extract the exported symbol list from a shared archive.
extract_expsyms_cmds=$lt_extract_expsyms_cmds
# Variables whose values should be saved in libtool wrapper scripts and
# restored at link time.
variables_saved_for_relink=$lt_variables_saved_for_relink
# Do we need the "lib" prefix for modules?
need_lib_prefix=$need_lib_prefix
# Do we need a version for libraries?
need_version=$need_version
# Library versioning type.
version_type=$version_type
# Shared library runtime path variable.
runpath_var=$runpath_var
# Shared library path variable.
shlibpath_var=$shlibpath_var
# Is shlibpath searched before the hard-coded library search path?
shlibpath_overrides_runpath=$shlibpath_overrides_runpath
# Format of library name prefix.
libname_spec=$lt_libname_spec
# List of archive names. First name is the real one, the rest are links.
# The last name is the one that the linker finds with -lNAME
library_names_spec=$lt_library_names_spec
# The coded name of the library, if different from the real name.
soname_spec=$lt_soname_spec
# Permission mode override for installation of shared libraries.
install_override_mode=$lt_install_override_mode
# Command to use after installation of a shared archive.
postinstall_cmds=$lt_postinstall_cmds
# Command to use after uninstallation of a shared archive.
postuninstall_cmds=$lt_postuninstall_cmds
# Commands used to finish a libtool library installation in a directory.
finish_cmds=$lt_finish_cmds
# As "finish_cmds", except a single script fragment to be evaled but
# not shown.
finish_eval=$lt_finish_eval
# Whether we should hardcode library paths into libraries.
hardcode_into_libs=$hardcode_into_libs
# Compile-time system search path for libraries.
sys_lib_search_path_spec=$lt_sys_lib_search_path_spec
# Run-time system search path for libraries.
sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec
# Whether dlopen is supported.
dlopen_support=$enable_dlopen
# Whether dlopen of programs is supported.
dlopen_self=$enable_dlopen_self
# Whether dlopen of statically linked programs is supported.
dlopen_self_static=$enable_dlopen_self_static
# Commands to strip libraries.
old_striplib=$lt_old_striplib
striplib=$lt_striplib
# The linker used to build libraries.
LD=$lt_LD
# How to create reloadable object files.
reload_flag=$lt_reload_flag
reload_cmds=$lt_reload_cmds
# Commands used to build an old-style archive.
old_archive_cmds=$lt_old_archive_cmds
# A language specific compiler.
CC=$lt_compiler
# Is the compiler the GNU compiler?
with_gcc=$GCC
# Compiler flag to turn off builtin functions.
no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag
# Additional compiler flags for building library objects.
pic_flag=$lt_lt_prog_compiler_pic
# How to pass a linker flag through the compiler.
wl=$lt_lt_prog_compiler_wl
# Compiler flag to prevent dynamic linking.
link_static_flag=$lt_lt_prog_compiler_static
# Does compiler simultaneously support -c and -o options?
compiler_c_o=$lt_lt_cv_prog_compiler_c_o
# Whether or not to add -lc for building shared libraries.
build_libtool_need_lc=$archive_cmds_need_lc
# Whether or not to disallow shared libs when runtime libs are static.
allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes
# Compiler flag to allow reflexive dlopens.
export_dynamic_flag_spec=$lt_export_dynamic_flag_spec
# Compiler flag to generate shared objects directly from archives.
whole_archive_flag_spec=$lt_whole_archive_flag_spec
# Whether the compiler copes with passing no objects directly.
compiler_needs_object=$lt_compiler_needs_object
# Create an old-style archive from a shared archive.
old_archive_from_new_cmds=$lt_old_archive_from_new_cmds
# Create a temporary old-style archive to link instead of a shared archive.
old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds
# Commands used to build a shared archive.
archive_cmds=$lt_archive_cmds
archive_expsym_cmds=$lt_archive_expsym_cmds
# Commands used to build a loadable module if different from building
# a shared archive.
module_cmds=$lt_module_cmds
module_expsym_cmds=$lt_module_expsym_cmds
# Whether we are building with GNU ld or not.
with_gnu_ld=$lt_with_gnu_ld
# Flag that allows shared libraries with undefined symbols to be built.
allow_undefined_flag=$lt_allow_undefined_flag
# Flag that enforces no undefined symbols.
no_undefined_flag=$lt_no_undefined_flag
# Flag to hardcode \$libdir into a binary during linking.
# This must work even if \$libdir does not exist
hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec
# Whether we need a single "-rpath" flag with a separated argument.
hardcode_libdir_separator=$lt_hardcode_libdir_separator
# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
# DIR into the resulting binary.
hardcode_direct=$hardcode_direct
# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
# DIR into the resulting binary and the resulting library dependency is
# "absolute",i.e impossible to change by setting \${shlibpath_var} if the
# library is relocated.
hardcode_direct_absolute=$hardcode_direct_absolute
# Set to "yes" if using the -LDIR flag during linking hardcodes DIR
# into the resulting binary.
hardcode_minus_L=$hardcode_minus_L
# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
# into the resulting binary.
hardcode_shlibpath_var=$hardcode_shlibpath_var
# Set to "yes" if building a shared library automatically hardcodes DIR
# into the library and all subsequent libraries and executables linked
# against it.
hardcode_automatic=$hardcode_automatic
# Set to yes if linker adds runtime paths of dependent libraries
# to runtime path list.
inherit_rpath=$inherit_rpath
# Whether libtool must link a program against all its dependency libraries.
link_all_deplibs=$link_all_deplibs
# Set to "yes" if exported symbols are required.
always_export_symbols=$always_export_symbols
# The commands to list exported symbols.
export_symbols_cmds=$lt_export_symbols_cmds
# Symbols that should not be listed in the preloaded symbols.
exclude_expsyms=$lt_exclude_expsyms
# Symbols that must always be exported.
include_expsyms=$lt_include_expsyms
# Commands necessary for linking programs (against libraries) with templates.
prelink_cmds=$lt_prelink_cmds
# Commands necessary for finishing linking programs.
postlink_cmds=$lt_postlink_cmds
# Specify filename containing input files.
file_list_spec=$lt_file_list_spec
# How to hardcode a shared library path into an executable.
hardcode_action=$hardcode_action
# ### END LIBTOOL CONFIG
_LT_EOF
case $host_os in
aix3*)
cat <<\_LT_EOF >> "$cfgfile"
# AIX sometimes has problems with the GCC collect2 program. For some
# reason, if we set the COLLECT_NAMES environment variable, the problems
# vanish in a puff of smoke.
if test "X${COLLECT_NAMES+set}" != Xset; then
COLLECT_NAMES=
export COLLECT_NAMES
fi
_LT_EOF
;;
esac
ltmain="$ac_aux_dir/ltmain.sh"
# We use sed instead of cat because bash on DJGPP gets confused if
# if finds mixed CR/LF and LF-only lines. Since sed operates in
# text mode, it properly converts lines to CR/LF. This bash problem
# is reportedly fixed, but why not run on old versions too?
sed '$q' "$ltmain" >> "$cfgfile" \
|| (rm -f "$cfgfile"; exit 1)
if test x"$xsi_shell" = xyes; then
sed -e '/^func_dirname ()$/,/^} # func_dirname /c\
func_dirname ()\
{\
\ case ${1} in\
\ */*) func_dirname_result="${1%/*}${2}" ;;\
\ * ) func_dirname_result="${3}" ;;\
\ esac\
} # Extended-shell func_dirname implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_basename ()$/,/^} # func_basename /c\
func_basename ()\
{\
\ func_basename_result="${1##*/}"\
} # Extended-shell func_basename implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_dirname_and_basename ()$/,/^} # func_dirname_and_basename /c\
func_dirname_and_basename ()\
{\
\ case ${1} in\
\ */*) func_dirname_result="${1%/*}${2}" ;;\
\ * ) func_dirname_result="${3}" ;;\
\ esac\
\ func_basename_result="${1##*/}"\
} # Extended-shell func_dirname_and_basename implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_stripname ()$/,/^} # func_stripname /c\
func_stripname ()\
{\
\ # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are\
\ # positional parameters, so assign one to ordinary parameter first.\
\ func_stripname_result=${3}\
\ func_stripname_result=${func_stripname_result#"${1}"}\
\ func_stripname_result=${func_stripname_result%"${2}"}\
} # Extended-shell func_stripname implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_split_long_opt ()$/,/^} # func_split_long_opt /c\
func_split_long_opt ()\
{\
\ func_split_long_opt_name=${1%%=*}\
\ func_split_long_opt_arg=${1#*=}\
} # Extended-shell func_split_long_opt implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_split_short_opt ()$/,/^} # func_split_short_opt /c\
func_split_short_opt ()\
{\
\ func_split_short_opt_arg=${1#??}\
\ func_split_short_opt_name=${1%"$func_split_short_opt_arg"}\
} # Extended-shell func_split_short_opt implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_lo2o ()$/,/^} # func_lo2o /c\
func_lo2o ()\
{\
\ case ${1} in\
\ *.lo) func_lo2o_result=${1%.lo}.${objext} ;;\
\ *) func_lo2o_result=${1} ;;\
\ esac\
} # Extended-shell func_lo2o implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_xform ()$/,/^} # func_xform /c\
func_xform ()\
{\
func_xform_result=${1%.*}.lo\
} # Extended-shell func_xform implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_arith ()$/,/^} # func_arith /c\
func_arith ()\
{\
func_arith_result=$(( $* ))\
} # Extended-shell func_arith implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_len ()$/,/^} # func_len /c\
func_len ()\
{\
func_len_result=${#1}\
} # Extended-shell func_len implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
fi
if test x"$lt_shell_append" = xyes; then
sed -e '/^func_append ()$/,/^} # func_append /c\
func_append ()\
{\
eval "${1}+=\\${2}"\
} # Extended-shell func_append implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
sed -e '/^func_append_quoted ()$/,/^} # func_append_quoted /c\
func_append_quoted ()\
{\
\ func_quote_for_eval "${2}"\
\ eval "${1}+=\\\\ \\$func_quote_for_eval_result"\
} # Extended-shell func_append_quoted implementation' "$cfgfile" > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
# Save a `func_append' function call where possible by direct use of '+='
sed -e 's%func_append \([a-zA-Z_]\{1,\}\) "%\1+="%g' $cfgfile > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
else
# Save a `func_append' function call even when '+=' is not available
sed -e 's%func_append \([a-zA-Z_]\{1,\}\) "%\1="$\1%g' $cfgfile > $cfgfile.tmp \
&& mv -f "$cfgfile.tmp" "$cfgfile" \
|| (rm -f "$cfgfile" && cp "$cfgfile.tmp" "$cfgfile" && rm -f "$cfgfile.tmp")
test 0 -eq $? || _lt_function_replace_fail=:
fi
if test x"$_lt_function_replace_fail" = x":"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Unable to substitute extended shell functions in $ofile" >&5
$as_echo "$as_me: WARNING: Unable to substitute extended shell functions in $ofile" >&2;}
fi
mv -f "$cfgfile" "$ofile" ||
(rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile")
chmod +x "$ofile"
cat <<_LT_EOF >> "$ofile"
# ### BEGIN LIBTOOL TAG CONFIG: F77
# The linker used to build libraries.
LD=$lt_LD_F77
# How to create reloadable object files.
reload_flag=$lt_reload_flag_F77
reload_cmds=$lt_reload_cmds_F77
# Commands used to build an old-style archive.
old_archive_cmds=$lt_old_archive_cmds_F77
# A language specific compiler.
CC=$lt_compiler_F77
# Is the compiler the GNU compiler?
with_gcc=$GCC_F77
# Compiler flag to turn off builtin functions.
no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag_F77
# Additional compiler flags for building library objects.
pic_flag=$lt_lt_prog_compiler_pic_F77
# How to pass a linker flag through the compiler.
wl=$lt_lt_prog_compiler_wl_F77
# Compiler flag to prevent dynamic linking.
link_static_flag=$lt_lt_prog_compiler_static_F77
# Does compiler simultaneously support -c and -o options?
compiler_c_o=$lt_lt_cv_prog_compiler_c_o_F77
# Whether or not to add -lc for building shared libraries.
build_libtool_need_lc=$archive_cmds_need_lc_F77
# Whether or not to disallow shared libs when runtime libs are static.
allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes_F77
# Compiler flag to allow reflexive dlopens.
export_dynamic_flag_spec=$lt_export_dynamic_flag_spec_F77
# Compiler flag to generate shared objects directly from archives.
whole_archive_flag_spec=$lt_whole_archive_flag_spec_F77
# Whether the compiler copes with passing no objects directly.
compiler_needs_object=$lt_compiler_needs_object_F77
# Create an old-style archive from a shared archive.
old_archive_from_new_cmds=$lt_old_archive_from_new_cmds_F77
# Create a temporary old-style archive to link instead of a shared archive.
old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds_F77
# Commands used to build a shared archive.
archive_cmds=$lt_archive_cmds_F77
archive_expsym_cmds=$lt_archive_expsym_cmds_F77
# Commands used to build a loadable module if different from building
# a shared archive.
module_cmds=$lt_module_cmds_F77
module_expsym_cmds=$lt_module_expsym_cmds_F77
# Whether we are building with GNU ld or not.
with_gnu_ld=$lt_with_gnu_ld_F77
# Flag that allows shared libraries with undefined symbols to be built.
allow_undefined_flag=$lt_allow_undefined_flag_F77
# Flag that enforces no undefined symbols.
no_undefined_flag=$lt_no_undefined_flag_F77
# Flag to hardcode \$libdir into a binary during linking.
# This must work even if \$libdir does not exist
hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec_F77
# Whether we need a single "-rpath" flag with a separated argument.
hardcode_libdir_separator=$lt_hardcode_libdir_separator_F77
# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
# DIR into the resulting binary.
hardcode_direct=$hardcode_direct_F77
# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes
# DIR into the resulting binary and the resulting library dependency is
# "absolute",i.e impossible to change by setting \${shlibpath_var} if the
# library is relocated.
hardcode_direct_absolute=$hardcode_direct_absolute_F77
# Set to "yes" if using the -LDIR flag during linking hardcodes DIR
# into the resulting binary.
hardcode_minus_L=$hardcode_minus_L_F77
# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR
# into the resulting binary.
hardcode_shlibpath_var=$hardcode_shlibpath_var_F77
# Set to "yes" if building a shared library automatically hardcodes DIR
# into the library and all subsequent libraries and executables linked
# against it.
hardcode_automatic=$hardcode_automatic_F77
# Set to yes if linker adds runtime paths of dependent libraries
# to runtime path list.
inherit_rpath=$inherit_rpath_F77
# Whether libtool must link a program against all its dependency libraries.
link_all_deplibs=$link_all_deplibs_F77
# Set to "yes" if exported symbols are required.
always_export_symbols=$always_export_symbols_F77
# The commands to list exported symbols.
export_symbols_cmds=$lt_export_symbols_cmds_F77
# Symbols that should not be listed in the preloaded symbols.
exclude_expsyms=$lt_exclude_expsyms_F77
# Symbols that must always be exported.
include_expsyms=$lt_include_expsyms_F77
# Commands necessary for linking programs (against libraries) with templates.
prelink_cmds=$lt_prelink_cmds_F77
# Commands necessary for finishing linking programs.
postlink_cmds=$lt_postlink_cmds_F77
# Specify filename containing input files.
file_list_spec=$lt_file_list_spec_F77
# How to hardcode a shared library path into an executable.
hardcode_action=$hardcode_action_F77
# ### END LIBTOOL TAG CONFIG: F77
_LT_EOF
;;
esac
done # for ac_tag
as_fn_exit 0
_ACEOF
ac_clean_files=$ac_clean_files_save
test $ac_write_fail = 0 ||
as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
# by configure, so config.status won't be able to write to it; its
# output is simply discarded. So we exec the FD to /dev/null,
# effectively closing config.log, so it can be properly (re)opened and
# appended to by config.status. When coming back to configure, we
# need to make the FD available again.
if test "$no_create" != yes; then
ac_cs_success=:
ac_config_status_args=
test "$silent" = yes &&
ac_config_status_args="$ac_config_status_args --quiet"
exec 5>/dev/null
$SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
$ac_cs_success || as_fn_exit 1
fi
if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
arpack-ng-3.1.5/arpack.pc.in 0000644 0001750 0001750 00000000271 12277373057 012513 0000000 0000000 prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
Name: arpack
Description: ARPACK-NG
Version: @PACKAGE_VERSION@
Libs: -L${libdir} -larpack @BLAS_LIBS@ @LAPACK_LIBS@
Cflags: