
PROGRAM TEST

IMPLICIT NONE

C

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

INTEGER N, NRHS

PARAMETER (N = 4)

PARAMETER (LDA = N)

PARAMETER (LDAF = LDA)

PARAMETER (LDB = N)

PARAMETER (LDIWRK = N)

PARAMETER (LDX = N)

PARAMETER (LDWORK = 3 * N)

PARAMETER (NRHS = 1)

C

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

DOUBLE PRECISION BERR(NRHS), FERR(NRHS), RCOND, SCALE(N)

DOUBLE PRECISION WORK(LDWORK), X(LDX,NRHS)

INTEGER ICOL, INFO, IROW, IWORK(LDIWRK)

CHARACTER*1 EQUED

C

EXTERNAL DPOSVX

C

C Initialize the array A to store in symmetric form the 4x4

C 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, 3*8D8, 1.0D0, 2.0D0, 2*8D8, 0.0D0,

$ 1.0D0, 2.0D0, 8D8, 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

DO 100, IROW = 1, N

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

$ (A(IROW,ICOL), ICOL = IROW, N)

100 CONTINUE

PRINT 1020

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

PRINT 1030

PRINT 1040, B

C

C Solve Ax=b and print the solution.

C

CALL DPOSVX ('EQUILIBRATE A', 'UPPER TRIANGLE OF A STORED',

$ N, NRHS, A, LDA, AF, LDAF, EQUED, SCALE,

$ B, LDB, X, LDX, RCOND, FERR, BERR, WORK,

$ IWORK, INFO)

IF (INFO .NE. 0) THEN

PRINT 1050, INFO

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

PRINT 1060

STOP 1

END IF

STOP 2

END IF

PRINT 1070

PRINT 1040, X

PRINT 1080, 1.0D0 / RCOND

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

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

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

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

PRINT 1130, (IROW, BERR(IROW), IROW = 1, NRHS)

PRINT 1140, (IROW, FERR(IROW), IROW = 1, NRHS)

C

1000 FORMAT (1X, 'A in full form:')

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

1020 FORMAT (/1X, 'A in symmetric form: (* in unused elements)')

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

1040 FORMAT (1X, F6.2)

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

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

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

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

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

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

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

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

1130 FORMAT (/1X, 'Backward error for system #', I1, ': ',

$ E12.6)

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

C

END

