C
C  Copyright 2000 Compaq Computer Corporation
C  
C  COMPAQ Registered in U.S. Patent and Trademark Office.
C  
C  Confidential computer software.  Valid license from Compaq required for
C  possession, use or copying.  Consistent with FAR 12.211 and 12.212,
C  Commerical Computer Software, Computer Software Documentation, and
C  Technical Data for Commmerical Items are licensed to the U.S. Government
C  under vendor's standard commerical license.
C
C---------------------------------------------------------------------------
C
C Example program for solving symmetric positive definite system of equations.
C
C---------------------------------------------------------------------------

         PROGRAM solver_f77_test
         IMPLICIT NONE
         INCLUDE 'cxml_dss.f77'

C---------------------------------------------------------------------------
C  Define the array and rhs vectors
C---------------------------------------------------------------------------

         INTEGER  nRows, nCols, nNonZeros, i, nRhs
         PARAMETER (nRows     = 5,
     1          nCols     = 5,
     2          nNonZeros = 9,
     3          nRhs      = 1)
        INTEGER rowIndex(nRows + 1), columns(nNonZeros)
        DOUBLE PRECISION values(nNonZeros), rhs(nRows)
        DATA rowIndex / 1, 6, 7, 8, 9, 10 /
        DATA columns  / 1, 2, 3, 4, 5, 2, 3, 4, 5 /
        DATA values   / 9, 1.5, 6, .75, 3, 0.5, 12, .625, 16 /
        DATA rhs      / 1, 2, 3, 4, 5 /

C---------------------------------------------------------------------------
C  Allocate storage for the solver handle and the solution vector
C---------------------------------------------------------------------------

        DOUBLE PRECISION solution(nRows)
        RECORD /CXML_DSS_HANDLE/ handle
        INTEGER          error

C---------------------------------------------------------------------------
C  Initialize the solver
C---------------------------------------------------------------------------

        error = dss_create(handle, CXML_DSS_DEFAULTS)
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Define the non-zero structure of the matrix
C---------------------------------------------------------------------------

        error = dss_define_structure( handle, CXML_DSS_SYMMETRIC,
     &               rowIndex, nRows, nCols, columns, nNonZeros )
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Reorder the matrix
C---------------------------------------------------------------------------

        error = dss_reorder( handle, CXML_DSS_DEFAULTS, 0)
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Factor the matrix
C---------------------------------------------------------------------------

        error = dss_factor_real( handle,
     &            CXML_DSS_DEFAULTS, VALUES)
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Get the solution vector
C---------------------------------------------------------------------------

        error = dss_solve_real( handle, CXML_DSS_DEFAULTS,
     &                           rhs, nRhs, solution)
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Deallocate solver storage
C---------------------------------------------------------------------------

        error = dss_delete( handle, CXML_DSS_DEFAULTS )
        IF (error .NE. CXML_DSS_SUCCESS ) GOTO 999

C---------------------------------------------------------------------------
C  Print solution vector
C---------------------------------------------------------------------------

        WRITE(*,900) (solution(i), i = 1, nCols)
 900    FORMAT(' Solution Array: ',5(F10.3))
        GOTO 1000
 999    WRITE(*,*) "Solver returned error code ", error
 1000   END
