diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index 071ee00d..2892a967 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -110,7 +110,9 @@ module psb_c_mat_mod procedure, pass(a) :: c_cscnv_base => psb_c_cscnv_base generic, public :: cscnv => c_cscnv, c_cscnv_ip, c_cscnv_base procedure, pass(a) :: reinit => psb_c_reinit - procedure, pass(a) :: print => psb_c_sparse_print + procedure, pass(a) :: print_i => psb_c_sparse_print + procedure, pass(a) :: print_n => psb_c_n_sparse_print + generic, public :: print => print_i, print_n procedure, pass(a) :: c_mv_from => psb_c_mv_from generic, public :: mv_from => c_mv_from procedure, pass(a) :: c_mv_to => psb_c_mv_to @@ -279,6 +281,18 @@ module psb_c_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_sparse_print end interface + + interface + subroutine psb_c_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + import :: psb_cspmat_type + character(len=*), intent(in) :: fname + class(psb_cspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + end subroutine psb_c_n_sparse_print + end interface interface subroutine psb_c_get_neigh(a,idx,neigh,n,info,lev) diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 4fb2028c..4a65eab1 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -110,7 +110,9 @@ module psb_s_mat_mod procedure, pass(a) :: s_cscnv_base => psb_s_cscnv_base generic, public :: cscnv => s_cscnv, s_cscnv_ip, s_cscnv_base procedure, pass(a) :: reinit => psb_s_reinit - procedure, pass(a) :: print => psb_s_sparse_print + procedure, pass(a) :: print_i => psb_s_sparse_print + procedure, pass(a) :: print_n => psb_s_n_sparse_print + generic, public :: print => print_i, print_n procedure, pass(a) :: s_mv_from => psb_s_mv_from generic, public :: mv_from => s_mv_from procedure, pass(a) :: s_mv_to => psb_s_mv_to @@ -280,6 +282,18 @@ module psb_s_mat_mod end subroutine psb_s_sparse_print end interface + interface + subroutine psb_s_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + import :: psb_sspmat_type + character(len=*), intent(in) :: fname + class(psb_sspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + end subroutine psb_s_n_sparse_print + end interface + interface subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) import :: psb_sspmat_type diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index b1abb024..d930d936 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -110,7 +110,9 @@ module psb_z_mat_mod procedure, pass(a) :: z_cscnv_base => psb_z_cscnv_base generic, public :: cscnv => z_cscnv, z_cscnv_ip, z_cscnv_base procedure, pass(a) :: reinit => psb_z_reinit - procedure, pass(a) :: print => psb_z_sparse_print + procedure, pass(a) :: print_i => psb_z_sparse_print + procedure, pass(a) :: print_n => psb_z_n_sparse_print + generic, public :: print => print_i, print_n procedure, pass(a) :: z_mv_from => psb_z_mv_from generic, public :: mv_from => z_mv_from procedure, pass(a) :: z_mv_to => psb_z_mv_to @@ -267,7 +269,6 @@ module psb_z_mat_mod end subroutine psb_z_set_upper end interface - interface subroutine psb_z_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) import :: psb_zspmat_type @@ -279,6 +280,18 @@ module psb_z_mat_mod integer, intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_sparse_print end interface + + interface + subroutine psb_z_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + import :: psb_zspmat_type + character(len=*), intent(in) :: fname + class(psb_zspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + end subroutine psb_z_n_sparse_print + end interface interface subroutine psb_z_get_neigh(a,idx,neigh,n,info,lev) diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index f598148f..4b3e6c98 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -496,6 +496,60 @@ subroutine psb_c_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) end subroutine psb_c_sparse_print +subroutine psb_c_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + use psb_c_mat_mod, psb_protect_name => psb_c_n_sparse_print + use psb_error_mod + implicit none + + character(len=*), intent(in) :: fname + class(psb_cspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + + Integer :: err_act, info, iout + logical :: isopen + character(len=20) :: name='sparse_print' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_get_erraction(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + iout = max(psb_inp_unit,psb_err_unit,psb_out_unit) + 1 + do + inquire(unit=iout, opened=isopen) + if (.not.isopen) exit + iout = iout + 1 + if (iout > 99) exit + end do + if (iout > 99) then + write(psb_err_unit,*) 'Error: could not find a free unit for I/O' + return + end if + open(iout,file=fname,iostat=info) + if (info == psb_success_) then + call a%a%print(iout,iv,eirs,eics,head,ivr,ivc) + close(iout) + else + write(psb_err_unit,*) 'Error: could not open ',fname,' for output' + end if + + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine psb_c_n_sparse_print subroutine psb_c_get_neigh(a,idx,neigh,n,info,lev) diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 1cc31802..c5896765 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -496,7 +496,60 @@ subroutine psb_s_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) end subroutine psb_s_sparse_print +subroutine psb_s_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + use psb_s_mat_mod, psb_protect_name => psb_s_n_sparse_print + use psb_error_mod + implicit none + + character(len=*), intent(in) :: fname + class(psb_sspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + + Integer :: err_act, info, iout + logical :: isopen + character(len=20) :: name='sparse_print' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_get_erraction(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + iout = max(psb_inp_unit,psb_err_unit,psb_out_unit) + 1 + do + inquire(unit=iout, opened=isopen) + if (.not.isopen) exit + iout = iout + 1 + if (iout > 99) exit + end do + if (iout > 99) then + write(psb_err_unit,*) 'Error: could not find a free unit for I/O' + return + end if + open(iout,file=fname,iostat=info) + if (info == psb_success_) then + call a%a%print(iout,iv,eirs,eics,head,ivr,ivc) + close(iout) + else + write(psb_err_unit,*) 'Error: could not open ',fname,' for output' + end if + + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return +end subroutine psb_s_n_sparse_print subroutine psb_s_get_neigh(a,idx,neigh,n,info,lev) use psb_s_mat_mod, psb_protect_name => psb_s_get_neigh diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 7873074d..877d9013 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -496,6 +496,60 @@ subroutine psb_z_sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc) end subroutine psb_z_sparse_print +subroutine psb_z_n_sparse_print(fname,a,iv,eirs,eics,head,ivr,ivc) + use psb_z_mat_mod, psb_protect_name => psb_z_n_sparse_print + use psb_error_mod + implicit none + + character(len=*), intent(in) :: fname + class(psb_zspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: eirs,eics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:), ivc(:) + + Integer :: err_act, info, iout + logical :: isopen + character(len=20) :: name='sparse_print' + logical, parameter :: debug=.false. + + info = psb_success_ + call psb_get_erraction(err_act) + if (.not.allocated(a%a)) then + info = psb_err_invalid_mat_state_ + call psb_errpush(info,name) + goto 9999 + endif + iout = max(psb_inp_unit,psb_err_unit,psb_out_unit) + 1 + do + inquire(unit=iout, opened=isopen) + if (.not.isopen) exit + iout = iout + 1 + if (iout > 99) exit + end do + if (iout > 99) then + write(psb_err_unit,*) 'Error: could not find a free unit for I/O' + return + end if + open(iout,file=fname,iostat=info) + if (info == psb_success_) then + call a%a%print(iout,iv,eirs,eics,head,ivr,ivc) + close(iout) + else + write(psb_err_unit,*) 'Error: could not open ',fname,' for output' + end if + + return + +9999 continue + + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + return + +end subroutine psb_z_n_sparse_print subroutine psb_z_get_neigh(a,idx,neigh,n,info,lev)