subroutine ccs_print ( m, n, ncc, icc, ccc, acc, title ) !*****************************************************************************80 ! !! ccs_print() prints a sparse matrix in CCS format. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 23 July 2014 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer M, the number of rows in the matrix. ! ! Input, integer N, the number of columns in the matrix. ! ! Input, integer NCC, the number of CCS elements. ! ! Input, integer ICC(NCC), the CCS rows. ! ! Input, integer CCC(N+1), the compressed CCS columns. ! ! Input, real ( kind = rk ) ACC(NCC), the CCS values. ! ! Input, character ( len = * ) TITLE, a title. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n integer ncc real ( kind = rk ) acc(ncc) integer ccc(n+1) integer i integer icc(ncc) integer j integer k integer m character ( len = * ) title write ( *, '(a)' ) ' ' write ( *, '(a)' ) trim ( title ) write ( *, '(i4,a,i4,a)' ) m, ' rows by ', n, ' columns' write ( *, '(a)' ) ' # I J A' write ( *, '(a)' ) ' ---- ---- ---- ----------------' write ( *, '(a)' ) ' ' if ( ccc(1) == 0 ) then j = 0 do k = 1, ncc i = icc(k) do while ( ccc(j+2) <= k - 1 ) j = j + 1 end do write ( *, '(2x,i4,2x,i4,2x,i4,2x,g16.8)' ) k - 1, i, j, acc(k) end do else j = 1 do k = 1, ncc i = icc(k) do while ( ccc(j+1) <= k ) j = j + 1 end do write ( *, '(2x,i4,2x,i4,2x,i4,2x,g16.8)' ) k, i, j, acc(k) end do end if return end subroutine ccs_to_st ( m, n, ncc, icc, ccc, acc, nst, ist, jst, ast ) !*****************************************************************************80 ! !! ccs_to_st() converts sparse matrix information from CCS to ST format. ! ! Discussion: ! ! Only JST actually needs to be computed. The other three output ! quantities are simply copies. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 23 July 2014 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer M, the number of rows. ! ! Input, integer N, the number of columns. ! ! Input, integer NCC, the number of CCS elements. ! ! Input, integer ICC(NCC), the CCS rows. ! ! Input, integer CCC(N+1), the CCS compressed columns. ! ! Input, real ( kind = rk ) ACC(NCC), the CCS values. ! ! Output, integer NST, the number of ST elements. ! ! Output, integer IST(NST), JST(NST), the ST rows and columns. ! ! Output, real ( kind = rk ) AST(NST), the ST values. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer n integer ncc real ( kind = rk ) ast(ncc) real ( kind = rk ) acc(ncc) integer ccc(n+1) integer icc(ncc) integer ist(ncc) integer j integer jhi integer jlo integer jst(ncc) integer k integer khi integer klo integer m integer nst call i4_fake_use ( m ) nst = 0 if ( ccc(1) == 0 ) then jlo = 0 jhi = n - 1 do j = jlo, jhi klo = ccc(j+1) khi = ccc(j+2) - 1 do k = klo, khi nst = nst + 1 ist(nst) = icc(k+1) jst(nst) = j ast(nst) = acc(k+1) end do end do else jlo = 1 jhi = n do j = jlo, jhi klo = ccc(j) khi = ccc(j+1) - 1 do k = klo, khi nst = nst + 1 ist(nst) = icc(k) jst(nst) = j ast(nst) = acc(k) end do end do end if return end subroutine i4_fake_use ( n ) !*****************************************************************************80 ! !! i4_fake_use() pretends to use a variable. ! ! Discussion: ! ! Some compilers will issue a warning if a variable is unused. ! Sometimes there's a good reason to include a variable in a program, ! but not to use it. Calling this function with that variable as ! the argument will shut the compiler up. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 21 April 2020 ! ! Author: ! ! John Burkardt ! ! Input: ! ! integer N, the variable to be "used". ! implicit none integer n if ( n /= n ) then write ( *, '(a)' ) ' i4_fake_use(): variable is NAN.' end if return end subroutine st_print ( m, n, nst, ist, jst, ast, title ) !*****************************************************************************80 ! !! st_print() prints a sparse matrix in ST format. ! ! Licensing: ! ! This code is distributed under the MIT license. ! ! Modified: ! ! 21 July 2014 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer M, the number of rows. ! ! Input, integer N, the number of columns. ! ! Input, integer NST, the number of ST elements. ! ! Input, integer IST(NST), JST(NST), the ST rows and columns. ! ! Input, real ( kind = rk ) AST(NST), the ST values. ! ! Input, character ( len = * ) TITLE, a title. ! implicit none integer, parameter :: rk = kind ( 1.0D+00 ) integer nst real ( kind = rk ) ast(nst) integer ist(nst) integer jst(nst) integer k integer m integer n character ( len = * ) title write ( *, '(a)' ) ' ' write ( *, '(a)' ) trim ( title ) write ( *, '(i4,a,i4,a)' ) m, ' rows by ', n, ' columns' write ( *, '(a)' ) ' # I J A' write ( *, '(a)' ) ' ---- ---- ---- --------------' write ( *, '(a)' ) ' ' do k = 1, nst write ( *, '(2x,i4,2x,i4,2x,i4,2x,g16.8)' ) k, ist(k), jst(k), ast(k) end do return end