MODULE sparse_lin_sys_ex04_mod ! .. Implicit None Statement .. IMPLICIT NONE ! .. Default Accessibility .. PUBLIC ! .. Intrinsic Functions .. INTRINSIC KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) REAL (wp), PARAMETER :: zero = 0.0_wp CONTAINS FUNCTION mat_vec(trans,u,i_mat_comm,a_mat_comm) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC SIZE ! .. Scalar Arguments .. LOGICAL, INTENT (IN) :: trans ! .. Array Arguments .. INTEGER, OPTIONAL, INTENT (IN) :: i_mat_comm(:) REAL (wp), OPTIONAL, INTENT (IN) :: a_mat_comm(:) REAL (wp), INTENT (IN) :: u(:) ! .. Function Return Value .. REAL (wp) :: mat_vec(SIZE(u)) ! .. Local Scalars .. INTEGER :: i, ir, jc, nnz ! .. Executable Statements .. nnz = SIZE(a_mat_comm) ! Compute matrix vector product. mat_vec = zero IF ( .NOT. trans) THEN DO i = 1, nnz ir = i_mat_comm(i) jc = i_mat_comm(i+nnz) mat_vec(ir) = mat_vec(ir) + a_mat_comm(i)*u(jc) END DO ELSE IF (trans) THEN DO i = 1, nnz ir = i_mat_comm(i) jc = i_mat_comm(i+nnz) mat_vec(jc) = mat_vec(jc) + a_mat_comm(i)*u(ir) END DO END IF END FUNCTION mat_vec END MODULE sparse_lin_sys_ex04_mod PROGRAM nag_sparse_lin_sys_ex04 ! Example Program Text for nag_sparse_lin_sys ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE sparse_lin_sys_ex04_mod, ONLY : mat_vec, wp, zero USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_sparse_lin_sys, ONLY : nag_sparse_gen_lin_sol ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. INTEGER :: i, n, nnz ! .. Local Arrays .. INTEGER, ALLOCATABLE :: row_col_index(:) REAL (wp), ALLOCATABLE :: b(:), value(:), x(:) ! .. Executable Statements .. WRITE (nag_std_out,*) & 'Example Program Results for nag_sparse_lin_sys_ex04' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n, nnz ALLOCATE (b(n),x(n),row_col_index(2*nnz),value(nnz)) ! The sparse matrix is given in Coordinates format (in any order). ! row_col_index and value are used to store the sparse matrix ! information to be passed to the mat_vec function as follows: ! . SIZE(value) = nnz ! . SIZE(row_col_index) = 2*nnz ! value(i), row_col_index(i) and row_col_index(i+nnz), ! . for i = 1,..,nnz contain the value, row index and column ! . index for entry i DO i = 1, nnz READ (nag_std_in,*) value(i), row_col_index(i), row_col_index(nnz+i) END DO READ (nag_std_in,*) (b(i),i=1,n) WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Method TFQMR with user supplied mat_vec' WRITE (nag_std_out,*) x = zero CALL nag_sparse_gen_lin_sol(mat_vec,b,x,method='t', & i_mat_comm=row_col_index,a_mat_comm=value) ! Output results WRITE (nag_std_out,*) ' Solution' WRITE (nag_std_out,'(10F7.1)') x DEALLOCATE (b,x,value,row_col_index) END PROGRAM nag_sparse_lin_sys_ex04