
PROGRAM TEST

IMPLICIT NONE

C

INTEGER LDA, LDVS, LDWORK, N

PARAMETER (N = 2)

PARAMETER (LDA = N)

PARAMETER (LDVS = 2 * N)

PARAMETER (LDWORK = 3 * N)

C

DOUBLE PRECISION A(LDA,N), TEMP, VS(LDVS,N)

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

INTEGER I, ICOL, INFO, IROW, SORT

C

EXTERNAL DGEES, 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 and Schur vectors of A.

C

CALL DGEES ('VECTORS AND EIGENVALUES', 'NOT SORTED', SELECT,

$ N, A, LDA, SORT, WR, WI, VS, LDVS, WORK, LDWORK,

$ TEMP, 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 and Schur vectors.

C

PRINT 1060

DO 120, IROW = 1, N

PRINT 1070, 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, 'Eigenvalue', 4X, 'Schur vector**T')

1070 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

C

C The value computed is always .TRUE. It is computed in

C the peculiar way below to avoid compiler messages about

C unused function arguments.

C

PRINT 1000

SELECT = (ARG1 .EQ. ARG2)

STOP

C

1000 FORMAT (///1X, '**** ERROR: ',

$ 'SELECT FUNCTION CALLED BUT NOT AVAILABLE. ****')

C

END

