
PROGRAM TEST

IMPLICIT NONE

C

INTEGER LDB, LDIWRK, LDWORK, N, NRHS

PARAMETER (N = 5)

PARAMETER (LDB = N)

PARAMETER (LDIWRK = N)

PARAMETER (LDWORK = 2 * N)

PARAMETER (NRHS = 1)

C

DOUBLE PRECISION ANORM, B(LDB,NRHS), DIAG(N), DLOWER(N1)

DOUBLE PRECISION DUP1(N1), DUP2(N2), RCOND, WORK(LDWORK)

INTEGER ICOL, INFO, IPIVOT(N), IROW, IWORK(LDIWRK)

C

EXTERNAL DGTCON, DGTTRF, DGTTRS

INTRINSIC ABS

C

C Initialize the arrays DLOWER, DIAG, and DUP1 to store

C the first subdiagonal, the diagonal, and the first

C superdiagonal of the coefficient matrix A shown below.

C Initialize the array B to store the right hand side

C matrix b shown below.

C

C 3 1 6

C 1 2 1 12

C A = 1 2 1 b = 18

C 1 2 1 12

C 1 1 6

C

DATA DLOWER / 1.0D0, 1.0D0, 1.0D0, 1.0D0 /

DATA DIAG / 3.0D0, 2.0D0, 2.0D0, 2.0D0, 1.0D0 /

DATA DUP1 / 1.0D0, 1.0D0, 1.0D0, 1.0D0 /

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

C

PRINT 1000

DO 100, IROW = 1, N

PRINT 1010, (0.0D0, ICOL = 1, IROW  2),

$ (DLOWER(ICOL + 1), ICOL = ABS(IROW  2), IROW  2),

$ DIAG(IROW),

$ (DUP1(IROW), ICOL = 1, MIN(1, N  IROW)),

$ (0.0D0, ICOL = IROW + 2, N)

100 CONTINUE

PRINT 1020

PRINT 1030, B

C

CALL DGTTRF (N, DLOWER, DIAG, DUP1, DUP2, IPIVOT, INFO)

IF (INFO .NE. 0) THEN

PRINT 1040, INFO

STOP 1

END IF

ANORM = 4.0D0

CALL DGTCON ('ONENORM', N, DLOWER, DIAG, DUP1, DUP2,

$ IPIVOT, ANORM, RCOND, WORK, IWORK, INFO)

IF (INFO .NE. 0) THEN

PRINT 1050, ABS (INFO)

STOP 2

END IF

PRINT 1060, 1.0D0 / RCOND

CALL DGTTRS ('NO TRANSPOSE A', N, NRHS, DLOWER, DIAG, DUP1,

$ DUP2, IPIVOT, B, LDB, INFO)

IF (INFO .NE. 0) THEN

PRINT 1070, INFO

STOP 3

END IF

PRINT 1080

PRINT 1030, B

C

1000 FORMAT (1X, 'A:')

1010 FORMAT (5(3X, F5.2))

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

1030 FORMAT (1X, F8.2)

1040 FORMAT (1X, 'Error factoring A, INFO = ', I5)

1050 FORMAT (1X, 'Illegal argument to DGTCON, argument #', I2)

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

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

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

C

END

