
PROGRAM TEST

IMPLICIT NONE

C

INTEGER LDA, LDVS, LDIWRK, LDWORK, N

PARAMETER (N = 2)

PARAMETER (LDA = N)

PARAMETER (LDVS = 2 * N)

PARAMETER (LDIWRK = N)

PARAMETER (LDWORK = 3 * N)

C

DOUBLE PRECISION A(LDA,N), RCONDE, RCONDV, SCRATCH

DOUBLE PRECISION VS(LDVS,N) , WORK(LDWORK), WR(N), WI(N)

INTEGER I, ICOL, INFO, IROW, IWORK(LDIWRK), SORT

C

EXTERNAL DGEESX, SELECT

INTRINSIC ABS

C

C Initialize the array A to store the matrix A shown below.

C

C A = 0 1

C 6 5

C

DATA A / 0.0D0, 6.0D0, 1.0D0, 5.0D0 /

C

C Print the initial value of A.

C

PRINT 1000

PRINT 1010, ((A(IROW,ICOL), ICOL = 1, N), IROW = 1, N)

C

C Compute the eigenvalues, condition numbers, and Schur

C vectors of A.

C

CALL DGEESX ('VECTORS AND EIGENVALUES', 'SORTED', SELECT,

$ 'BOTH CONDITION NUMBERS', N, A, LDA, SORT, WR,

$ WI, VS, LDVS, RCONDE, RCONDV, WORK, LDWORK,

$ IWORK, LDIWRK, SCRATCH, INFO)

IF (INFO .NE. 0) THEN

IF (INFO .LT. 0) THEN

PRINT 1020, ABS(INFO)

STOP 1

ELSEIF (INFO .LE. N) THEN

PRINT 1030, INFO

STOP 2

ELSEIF (INFO .EQ. N + 1) THEN

PRINT 1040

ELSE

PRINT 1050

END IF

END IF

C

C Print the eigenvalues, condition numbers, and Schur vectors.

C

PRINT 1060, 1.0D0 / RCONDE

PRINT 1070, 1.0D0 / RCONDV

PRINT 1080

DO 120, IROW = 1, N

PRINT 1090, WR(IROW), (VS(I,IROW), I = 1, N)

120 CONTINUE

C

1000 FORMAT (1X, 'A:')

1010 FORMAT (2(3X, F4.1))

1020 FORMAT (/1X, 'Illegal argument to DGEES, argument #', I2)

1030 FORMAT (/1X, 'QR failed to converge, INFO = ', I2)

1040 FORMAT (/1X, 'Eigenvalues could not be reordered; problem',

$ /1X, 'is very illconditioned.')

1050 FORMAT (/1X, 'Leading eigenvalues in the Schur form no',

$ /1X, 'longer satisfy SELECT = .TRUE.')

1060 FORMAT (/1X, 'Condition number of the eigenvalues: ', F6.1)

1070 FORMAT (1X, 'Condition number of the subspace: ', F6.1)

1080 FORMAT (/1X, 'Eigenvalue', 4X, 'Schur vector**T')

1090 FORMAT (1X, F5.2, 10X, '[', F4.2, ', ', F4.2, ']')

C

END


LOGICAL FUNCTION SELECT (ARG1, ARG2)

IMPLICIT NONE

C

DOUBLE PRECISION ARG1, ARG2

INTRINSIC INT


SELECT = (ARG1 .EQ. ARG2)

C

END

