
PROGRAM TEST

IMPLICIT NONE

C

INTEGER ITYPE, LDEVEC, LDWORK, LENGTA, LENGTB, N

PARAMETER (ITYPE = 1)

PARAMETER (N = 3)

PARAMETER (LDEVEC = N)

PARAMETER (LDWORK = 3 * N)

PARAMETER (LENGTA = (N * N + N) / 2)

PARAMETER (LENGTB = (N * N + N) / 2)

C

DOUBLE PRECISION A(LENGTA), B(LENGTB), EVALS(N)

DOUBLE PRECISION EVECS(LDEVEC,N), WORK(LDWORK)

INTEGER ICOL, INFO, IROW

C

EXTERNAL DSPGV

INTRINSIC ABS

C

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

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

C

C 12 0 4 6 0 2

C A = 0 6 0 B = 0 2 0

C 4 0 4 2 0 2

C

DATA A / 1.2D1, 0.0D0, 6.0D0, 4.0D0, 0.0D0, 4.0D0 /

DATA B / 6.0D0, 0.0D0, 2.0D0, 2.0D0, 0.0D0, 2.0D0 /

C

C Print the initial value of the arrays.

C

PRINT 1000

PRINT 1010, A(1), A(2), A(4)

PRINT 1010, A(2), A(3), A(5)

PRINT 1010, A(4), A(5), A(6)

PRINT 1020

PRINT 1010, B(1), B(2), B(4)

PRINT 1010, B(2), B(3), B(5)

PRINT 1010, B(4), B(5), B(6)

C

CALL DSPGV (ITYPE, 'VALUES AND EIGENVECTORS',

$ 'UPPER TRIANGLES OF A AND B STORED', N, A, B,

$ EVALS, EVECS, LDEVEC, WORK, INFO)

IF (INFO .LT. 0) THEN

PRINT 1030, ABS(INFO)

STOP 1

ELSE IF (INFO .GT. N) THEN

PRINT 1040, INFO

STOP 2

ELSE IF (INFO .GT. 0) THEN

PRINT 1050, INFO

STOP 3

END IF

C

C Print the eigenvalues and eigenvectors.

C

PRINT 1060

DO 140, IROW = 1, N

PRINT 1070, EVALS(IROW), (EVECS(IROW,ICOL), ICOL = 1, N)

140 CONTINUE

C

1000 FORMAT (1X, 'A:')

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

1020 FORMAT (/1X, 'B:')

1030 FORMAT (/1X, 'Illegal argument to DSPGV, argument #', I2)

1040 FORMAT (/1X, 'B is not positive definite, INFO = ', I2)

1050 FORMAT (/1X, 'Convergence failure, INFO = ', I2)

1060 FORMAT (/1X, 'Eigenvalue', 6X, 'Eigenvector**T')

1070 FORMAT (1X, F7.2, 6X, '[', 2(F5.3, ', '), F5.3, ']')

C

END

