PROGRAM nag_sparse_mat_ex04

      ! Example Program Text for nag_sparse_mat
      ! NAG fl90, Release 4. NAG Copyright 2000.

      ! .. Use Statements ..
      USE nag_examples_io, ONLY : nag_std_in, nag_std_out
      USE nag_sparse_mat, ONLY : nag_sparse_mat_init_dia, &
       nag_sparse_mat_real_wp => nag_sparse_mat_real_dp, &
       nag_sparse_mat_extract, nag_deallocate
      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Intrinsic Functions ..
      INTRINSIC ABS, KIND
      ! .. Parameters ..
      INTEGER, PARAMETER :: wp = KIND(1.0D0)
      ! .. Local Scalars ..
      INTEGER :: i, m, nnz, n_diag, ret_m
      TYPE (nag_sparse_mat_real_wp) :: a
      ! .. Local Arrays ..
      INTEGER, ALLOCATABLE :: diag_indx(:), ret_col_indx(:), ret_row_indx(:)
      REAL (wp), ALLOCATABLE :: ret_value(:), value(:,:)
      ! .. Executable Statements ..
      WRITE (nag_std_out,*) 'Example Program Results for nag_sparse_mat_ex04'

      READ (nag_std_in,*)          ! Skip heading in data file
      READ (nag_std_in,*) m, n_diag

      ! allocate required arrays
      ALLOCATE (diag_indx(n_diag),value(m,n_diag))

      ! Read values and indices
      DO i = 1, n_diag
        READ (nag_std_in,*) diag_indx(i)
        IF (diag_indx(i)<=0) THEN
          READ (nag_std_in,*) value(ABS(diag_indx(i))+1:,i)
        ELSE
          READ (nag_std_in,*) value(:m-diag_indx(i),i)
        END IF
      END DO

      CALL nag_sparse_mat_init_dia(a,m,value,diag_indx)

      CALL nag_sparse_mat_extract(a,ret_m,nnz=nnz)

      ! allocate required arrays
      ALLOCATE (ret_row_indx(nnz),ret_col_indx(nnz),ret_value(nnz))
      CALL nag_sparse_mat_extract(a,ret_m,value=ret_value, &
       row_indx=ret_row_indx,col_indx=ret_col_indx)

      WRITE (nag_std_out,*)
      WRITE (nag_std_out,*) ' The output of nag_sparse_mat_extract &
       &(the sparse matrix in COO format):'
      WRITE (nag_std_out,*)
      WRITE (nag_std_out,*) '   row index    col. index    value'
      DO i = 1, nnz
        WRITE (nag_std_out,'(I9,I14,F12.1)') ret_row_indx(i), ret_col_indx(i), &
         ret_value(i)
      END DO

      CALL nag_deallocate(a)
      DEALLOCATE (value,diag_indx,ret_row_indx,ret_col_indx,ret_value)

    END PROGRAM nag_sparse_mat_ex04