
PROGRAM TEST

IMPLICIT NONE

C

INTEGER LDA, LDAF, LDB, LDIWRK, LDWORK, LDX

INTEGER N, NRHS

PARAMETER (N = 4)

PARAMETER (LDA = (N * (N + 1)) / 2)

PARAMETER (LDAF = LDA)

PARAMETER (LDB = N)

PARAMETER (LDIWRK = N)

PARAMETER (LDX = N)

PARAMETER (LDWORK = 3 * N)

PARAMETER (NRHS = 1)

C

DOUBLE PRECISION A(LDA), AF(LDAF), B(LDB,NRHS), BERR(NRHS)

DOUBLE PRECISION FERR(NRHS), RCOND, SCALE(N), WORK(LDWORK)

DOUBLE PRECISION X(LDX,NRHS)

INTEGER I, INFO, IWORK(LDIWRK)

CHARACTER*1 EQUED

C

EXTERNAL DPPSVX

C

C Initialize the array A to store in symmetric form the

C 4x4 symmetric positive definite matrix A shown below.

C Initialize the array B to store the right hand side

C vector b shown below.

C

C 2 1 0 0 6

C A = 1 2 1 0 b = 12

C 0 1 2 1 12

C 0 0 1 2 6

C

DATA A / 2.0D0, 1.0D0, 2.0D0, 0.0D0, 1.0D0, 2.0D0,

$ 0.0D0, 0.0D0, 1.0D0, 2.0D0 /

DATA B / 6.0D0, 1.2D1, 1.2D1, 6.0D0 /

C

C Print the initial values of the arrays.

C

PRINT 1000

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

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

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

PRINT 1010, A(7), A(8), A(9), A(10)

PRINT 1020

PRINT 1030, B

C

C Solve Ax=b and print the solution.

C

CALL DPPSVX ('EQUILIBRATE A IF NECESSARY',

$ 'UPPER TRIANGLE OF A STORED', N, NRHS, A, AF,

$ EQUED, SCALE, B, LDB, X, LDX, RCOND, FERR,

$ BERR, WORK, IWORK, INFO)

IF (INFO .NE. 0) THEN

PRINT 1040, INFO

IF (INFO .EQ. (N + 1)) THEN

PRINT 1050

STOP 1

END IF

STOP 2

END IF

PRINT 1060

PRINT 1030, X

PRINT 1070, 1.0D0 / RCOND

IF (EQUED .EQ. 'N') PRINT 1080

IF (EQUED .EQ. 'R') PRINT 1090

IF (EQUED .EQ. 'C') PRINT 1100

IF (EQUED .EQ. 'B') PRINT 1110

PRINT 1120, (I, BERR(I), I = 1, NRHS)

PRINT 1130, (I, FERR(I), I = 1, NRHS)

C

1000 FORMAT (1X, 'A:')

1010 FORMAT (4(3X, F6.3))

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

1030 FORMAT (1X, F6.2)

1040 FORMAT (1X, 'Error solving Ax=b, INFO = ', I5)

1050 FORMAT (1X, 'Matrix is singular to working precision.')

1060 FORMAT (/1X, 'x:')

1070 FORMAT (/1X, 'Estimated condition number of A: ', F7.2)

1080 FORMAT (1X, 'No equilibration was required for A.')

1090 FORMAT (1X, 'Row equilibration was done on A.')

1100 FORMAT (1X, 'Column equilibration was done on A.')

1110 FORMAT (1X, 'Row and column equilibration was done on A.')

1120 FORMAT (/1X, 'Backward error for system #', I1, ': ', E12.6)

1130 FORMAT (1X, 'Forward error for system #', I1, ': ', E12.6)

C

END

