!
!  Copyright 2000 Compaq Computer Corporation
!  
!  COMPAQ Registered in U.S. Patent and Trademark Office.
!  
!  Confidential computer software.  Valid license from Compaq required for
!  possession, use or copying.  Consistent with FAR 12.211 and 12.212,
!  Commerical Computer Software, Computer Software Documentation, and
!  Technical Data for Commmerical Items are licensed to the U.S. Government
!  under vendor's standard commerical license.
!
!	1-002	Reformatted the source file to "free form."  JM Arnold
!		5 Mar 2001.

!---------------------------------------------------------------------------
!
! Example program for solving a symmetric positive definite system of
! equations.
!
!---------------------------------------------------------------------------

!DEC$ FREEFORM

PROGRAM solver_f90_test

INCLUDE 'cxml_include.f90'  !  Include the standard CXML "header file."

IMPLICIT NONE

INTEGER, PARAMETER :: dp = KIND(1.0D0)
INTEGER :: error
INTEGER :: i

!  Define the data arrays and the solution and rhs vectors.

INTEGER, ALLOCATABLE :: columns( : )
INTEGER :: nCols
INTEGER :: nNonZeros
INTEGER :: nRhs
INTEGER :: nRows
REAL(KIND=DP), ALLOCATABLE :: rhs( : )
INTEGER, ALLOCATABLE :: rowIndex( : )
REAL(KIND=DP), ALLOCATABLE :: solution( : )
REAL(KIND=DP), ALLOCATABLE :: values( : )
TYPE(CXML_DSS_HANDLE) :: handle  !  Allocate storage for the solver handle.
 
!  Set the problem to be solved.

nRows = 5
nCols = 5
nNonZeros = 9
nRhs = 1
ALLOCATE( rowIndex( nRows + 1 ) )
rowIndex = (/ 1, 6, 7, 8, 9, 10 /)
ALLOCATE( columns( nNonZeros ) )
columns = (/ 1, 2, 3, 4, 5, 2, 3, 4, 5 /)
ALLOCATE( values( nNonZeros ) )
values = (/ 9.0_DP, 1.5_DP, 6.0_DP, 0.75_DP, 3.0_DP, 0.5_DP, 12.0_DP,   &
     & 0.625_DP, 16.0_DP /)
ALLOCATE( rhs( nRows ) )
rhs = (/ 1.0_DP, 2.0_DP, 3.0_DP, 4.0_DP, 5.0_DP /)

!  Initialize the solver.

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

!  Define the non-zero structure of the matrix.

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

!  Reorder the matrix.

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

!  Factor the matrix.

error = dss_factor_real( handle, CXML_DSS_DEFAULTS, values )
IF (error /= CXML_DSS_SUCCESS) GOTO 999
      
!  Allocate the solution vector and solve the problem.

ALLOCATE( solution( nRows ) )
error = dss_solve_real(handle, CXML_DSS_DEFAULTS, rhs, nRhs, solution )
IF (error /= CXML_DSS_SUCCESS) GOTO 999

!  Deallocate solver storage and various local arrays.

error = dss_delete( handle, CXML_DSS_DEFAULTS )

IF (error /= CXML_DSS_SUCCESS ) GOTO 999
IF ( ALLOCATED( rowIndex) ) DEALLOCATE( rowIndex )
IF ( ALLOCATED( columns ) ) DEALLOCATE( columns )
IF ( ALLOCATED( values ) ) DEALLOCATE( values )
IF ( ALLOCATED( rhs ) ) DEALLOCATE( rhs )

!  Print the solution vector, deallocate it and exit

WRITE(*,"('Solution Array: '(5F10.3))") ( solution(i), i = 1, nCols )
IF ( ALLOCATED( solution ) ) DEALLOCATE( solution )
GOTO 1000

!  Print an error message and exit

999 WRITE(*,*) "Solver returned error code ", error

1000 CONTINUE

END  PROGRAM solver_f90_test
