From 01ffca76d20c1b070c04c0121d61e6a5bf1bccd8 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sat, 15 Feb 2020 15:08:41 +0000 Subject: [PATCH] Change mat%print interface, and refactor. --- base/modules/serial/psb_base_mat_mod.F90 | 6 +-- base/modules/serial/psb_c_base_mat_mod.F90 | 60 +++++++++++++++++++-- base/modules/serial/psb_c_csc_mat_mod.f90 | 4 +- base/modules/serial/psb_c_csr_mat_mod.f90 | 4 +- base/modules/serial/psb_c_mat_mod.F90 | 8 +-- base/modules/serial/psb_c_serial_mod.f90 | 8 +-- base/modules/serial/psb_d_base_mat_mod.F90 | 60 +++++++++++++++++++-- base/modules/serial/psb_d_csc_mat_mod.f90 | 4 +- base/modules/serial/psb_d_csr_mat_mod.f90 | 4 +- base/modules/serial/psb_d_mat_mod.F90 | 8 +-- base/modules/serial/psb_d_serial_mod.f90 | 8 +-- base/modules/serial/psb_s_base_mat_mod.F90 | 60 +++++++++++++++++++-- base/modules/serial/psb_s_csc_mat_mod.f90 | 4 +- base/modules/serial/psb_s_csr_mat_mod.f90 | 4 +- base/modules/serial/psb_s_mat_mod.F90 | 8 +-- base/modules/serial/psb_s_serial_mod.f90 | 8 +-- base/modules/serial/psb_z_base_mat_mod.F90 | 60 +++++++++++++++++++-- base/modules/serial/psb_z_csc_mat_mod.f90 | 4 +- base/modules/serial/psb_z_csr_mat_mod.f90 | 4 +- base/modules/serial/psb_z_mat_mod.F90 | 8 +-- base/modules/serial/psb_z_serial_mod.f90 | 8 +-- base/serial/impl/psb_c_coo_impl.F90 | 61 +++++++-------------- base/serial/impl/psb_c_csc_impl.f90 | 62 +++++++--------------- base/serial/impl/psb_c_csr_impl.f90 | 61 ++++++++------------- base/serial/impl/psb_c_mat_impl.F90 | 8 +-- base/serial/impl/psb_d_coo_impl.F90 | 61 +++++++-------------- base/serial/impl/psb_d_csc_impl.f90 | 62 +++++++--------------- base/serial/impl/psb_d_csr_impl.f90 | 61 ++++++++------------- base/serial/impl/psb_d_mat_impl.F90 | 8 +-- base/serial/impl/psb_s_coo_impl.F90 | 61 +++++++-------------- base/serial/impl/psb_s_csc_impl.f90 | 62 +++++++--------------- base/serial/impl/psb_s_csr_impl.f90 | 61 ++++++++------------- base/serial/impl/psb_s_mat_impl.F90 | 8 +-- base/serial/impl/psb_z_coo_impl.F90 | 61 +++++++-------------- base/serial/impl/psb_z_csc_impl.f90 | 62 +++++++--------------- base/serial/impl/psb_z_csr_impl.f90 | 61 ++++++++------------- base/serial/impl/psb_z_mat_impl.F90 | 8 +-- 37 files changed, 531 insertions(+), 579 deletions(-) diff --git a/base/modules/serial/psb_base_mat_mod.F90 b/base/modules/serial/psb_base_mat_mod.F90 index 8ebc7dc2..b108e9ae 100644 --- a/base/modules/serial/psb_base_mat_mod.F90 +++ b/base/modules/serial/psb_base_mat_mod.F90 @@ -306,12 +306,12 @@ module psb_base_mat_mod ! interface subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc) - import :: psb_ipk_, psb_epk_, psb_base_sparse_mat + import :: psb_ipk_, psb_epk_, psb_base_sparse_mat, psb_lpk_ integer(psb_ipk_), intent(in) :: iout class(psb_base_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_base_sparse_print end interface diff --git a/base/modules/serial/psb_c_base_mat_mod.F90 b/base/modules/serial/psb_c_base_mat_mod.F90 index cf7152db..66d76a1c 100644 --- a/base/modules/serial/psb_c_base_mat_mod.F90 +++ b/base/modules/serial/psb_c_base_mat_mod.F90 @@ -1713,9 +1713,9 @@ module psb_c_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_coo_print end interface @@ -3541,9 +3541,61 @@ module psb_c_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lc_coo_scals end interface + + public :: psb_c_get_print_frmt, psb_lc_get_print_frmt + +contains + + function psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_c_get_print_frmt + + function psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_lc_get_print_frmt -contains - ! == ================================== ! diff --git a/base/modules/serial/psb_c_csc_mat_mod.f90 b/base/modules/serial/psb_c_csc_mat_mod.f90 index 62f79c7b..5a98200e 100644 --- a/base/modules/serial/psb_c_csc_mat_mod.f90 +++ b/base/modules/serial/psb_c_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_c_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_csc_print end interface diff --git a/base/modules/serial/psb_c_csr_mat_mod.f90 b/base/modules/serial/psb_c_csr_mat_mod.f90 index 5e502eba..e3b18af0 100644 --- a/base/modules/serial/psb_c_csr_mat_mod.f90 +++ b/base/modules/serial/psb_c_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_c_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_c_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_csr_print end interface ! diff --git a/base/modules/serial/psb_c_mat_mod.F90 b/base/modules/serial/psb_c_mat_mod.F90 index 3c608a64..7d727f99 100644 --- a/base/modules/serial/psb_c_mat_mod.F90 +++ b/base/modules/serial/psb_c_mat_mod.F90 @@ -565,9 +565,9 @@ module psb_c_mat_mod import :: psb_ipk_, psb_lpk_, psb_cspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_sparse_print end interface @@ -576,9 +576,9 @@ module psb_c_mat_mod import :: psb_ipk_, psb_lpk_, psb_cspmat_type character(len=*), intent(in) :: fname class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_c_n_sparse_print end interface diff --git a/base/modules/serial/psb_c_serial_mod.f90 b/base/modules/serial/psb_c_serial_mod.f90 index b3e3abd0..9c43f3e7 100644 --- a/base/modules/serial/psb_c_serial_mod.f90 +++ b/base/modules/serial/psb_c_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_c_mat_mod, only : psb_cspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_c_mat_mod, only : psb_cspmat_type character(len=*), intent(in) :: fname type(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_d_base_mat_mod.F90 b/base/modules/serial/psb_d_base_mat_mod.F90 index a734930e..92ffaeb1 100644 --- a/base/modules/serial/psb_d_base_mat_mod.F90 +++ b/base/modules/serial/psb_d_base_mat_mod.F90 @@ -1713,9 +1713,9 @@ module psb_d_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_coo_print end interface @@ -3541,9 +3541,61 @@ module psb_d_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ld_coo_scals end interface + + public :: psb_d_get_print_frmt, psb_ld_get_print_frmt + +contains + + function psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_d_get_print_frmt + + function psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_ld_get_print_frmt -contains - ! == ================================== ! diff --git a/base/modules/serial/psb_d_csc_mat_mod.f90 b/base/modules/serial/psb_d_csc_mat_mod.f90 index 9ab0c2fc..8a479926 100644 --- a/base/modules/serial/psb_d_csc_mat_mod.f90 +++ b/base/modules/serial/psb_d_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_d_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_csc_print end interface diff --git a/base/modules/serial/psb_d_csr_mat_mod.f90 b/base/modules/serial/psb_d_csr_mat_mod.f90 index c84ee4f2..bd4cb9f9 100644 --- a/base/modules/serial/psb_d_csr_mat_mod.f90 +++ b/base/modules/serial/psb_d_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_d_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_d_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_csr_print end interface ! diff --git a/base/modules/serial/psb_d_mat_mod.F90 b/base/modules/serial/psb_d_mat_mod.F90 index 4964587e..b0b5fef3 100644 --- a/base/modules/serial/psb_d_mat_mod.F90 +++ b/base/modules/serial/psb_d_mat_mod.F90 @@ -565,9 +565,9 @@ module psb_d_mat_mod import :: psb_ipk_, psb_lpk_, psb_dspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_sparse_print end interface @@ -576,9 +576,9 @@ module psb_d_mat_mod import :: psb_ipk_, psb_lpk_, psb_dspmat_type character(len=*), intent(in) :: fname class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_d_n_sparse_print end interface diff --git a/base/modules/serial/psb_d_serial_mod.f90 b/base/modules/serial/psb_d_serial_mod.f90 index e43be2ac..523282f5 100644 --- a/base/modules/serial/psb_d_serial_mod.f90 +++ b/base/modules/serial/psb_d_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_d_mat_mod, only : psb_dspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_d_mat_mod, only : psb_dspmat_type character(len=*), intent(in) :: fname type(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_s_base_mat_mod.F90 b/base/modules/serial/psb_s_base_mat_mod.F90 index b5fc2250..f665a048 100644 --- a/base/modules/serial/psb_s_base_mat_mod.F90 +++ b/base/modules/serial/psb_s_base_mat_mod.F90 @@ -1713,9 +1713,9 @@ module psb_s_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_coo_print end interface @@ -3541,9 +3541,61 @@ module psb_s_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_ls_coo_scals end interface + + public :: psb_s_get_print_frmt, psb_ls_get_print_frmt + +contains + + function psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_s_get_print_frmt + + function psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='real' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_ls_get_print_frmt -contains - ! == ================================== ! diff --git a/base/modules/serial/psb_s_csc_mat_mod.f90 b/base/modules/serial/psb_s_csc_mat_mod.f90 index 54278539..30841854 100644 --- a/base/modules/serial/psb_s_csc_mat_mod.f90 +++ b/base/modules/serial/psb_s_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_s_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_csc_print end interface diff --git a/base/modules/serial/psb_s_csr_mat_mod.f90 b/base/modules/serial/psb_s_csr_mat_mod.f90 index 14b41bff..5dd0871f 100644 --- a/base/modules/serial/psb_s_csr_mat_mod.f90 +++ b/base/modules/serial/psb_s_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_s_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_s_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_csr_print end interface ! diff --git a/base/modules/serial/psb_s_mat_mod.F90 b/base/modules/serial/psb_s_mat_mod.F90 index 20f804a7..d3834cc1 100644 --- a/base/modules/serial/psb_s_mat_mod.F90 +++ b/base/modules/serial/psb_s_mat_mod.F90 @@ -565,9 +565,9 @@ module psb_s_mat_mod import :: psb_ipk_, psb_lpk_, psb_sspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_sparse_print end interface @@ -576,9 +576,9 @@ module psb_s_mat_mod import :: psb_ipk_, psb_lpk_, psb_sspmat_type character(len=*), intent(in) :: fname class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_s_n_sparse_print end interface diff --git a/base/modules/serial/psb_s_serial_mod.f90 b/base/modules/serial/psb_s_serial_mod.f90 index 45ed7dbb..81583f64 100644 --- a/base/modules/serial/psb_s_serial_mod.f90 +++ b/base/modules/serial/psb_s_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_s_mat_mod, only : psb_sspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_s_mat_mod, only : psb_sspmat_type character(len=*), intent(in) :: fname type(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/modules/serial/psb_z_base_mat_mod.F90 b/base/modules/serial/psb_z_base_mat_mod.F90 index 59a11faf..4e9ce7eb 100644 --- a/base/modules/serial/psb_z_base_mat_mod.F90 +++ b/base/modules/serial/psb_z_base_mat_mod.F90 @@ -1713,9 +1713,9 @@ module psb_z_base_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_coo_print end interface @@ -3541,9 +3541,61 @@ module psb_z_base_mat_mod integer(psb_ipk_), intent(out) :: info end subroutine psb_lz_coo_scals end interface + + public :: psb_z_get_print_frmt, psb_lz_get_print_frmt + +contains + + function psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_ipk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_ipk_) :: ni + nmx = max(nr,nc,ione) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_z_get_print_frmt + + function psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) result(frmt) + + implicit none + character(len=80) :: frmt + integer(psb_lpk_), intent(in) :: nr, nc, nz + integer(psb_lpk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) + ! + character(len=*), parameter :: datatype='complex' + integer(psb_lpk_) :: nmx + integer(psb_lpk_) :: ni + nmx = max(nr,nc,lone) + if (present(iv)) nmx = max(nmx,maxval(abs(iv(1:nc)))) + if (present(ivr)) nmx = max(nmx,maxval(abs(ivr(1:nr)))) + if (present(ivc)) nmx = max(nmx,maxval(abs(ivc(1:nc)))) + ni = floor(log10(1.0*nmx)) + 2 + + if (datatype=='complex') then + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' + else + write(frmt,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' + end if + + end function psb_lz_get_print_frmt -contains - ! == ================================== ! diff --git a/base/modules/serial/psb_z_csc_mat_mod.f90 b/base/modules/serial/psb_z_csc_mat_mod.f90 index c6586089..67714cff 100644 --- a/base/modules/serial/psb_z_csc_mat_mod.f90 +++ b/base/modules/serial/psb_z_csc_mat_mod.f90 @@ -219,9 +219,9 @@ module psb_z_csc_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_csc_print end interface diff --git a/base/modules/serial/psb_z_csr_mat_mod.f90 b/base/modules/serial/psb_z_csr_mat_mod.f90 index 6e62fa9c..b8267ac6 100644 --- a/base/modules/serial/psb_z_csr_mat_mod.f90 +++ b/base/modules/serial/psb_z_csr_mat_mod.f90 @@ -169,9 +169,9 @@ module psb_z_csr_mat_mod import integer(psb_ipk_), intent(in) :: iout class(psb_z_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_csr_print end interface ! diff --git a/base/modules/serial/psb_z_mat_mod.F90 b/base/modules/serial/psb_z_mat_mod.F90 index a73062f1..2ba886b5 100644 --- a/base/modules/serial/psb_z_mat_mod.F90 +++ b/base/modules/serial/psb_z_mat_mod.F90 @@ -565,9 +565,9 @@ module psb_z_mat_mod import :: psb_ipk_, psb_lpk_, psb_zspmat_type integer(psb_ipk_), intent(in) :: iout class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_sparse_print end interface @@ -576,9 +576,9 @@ module psb_z_mat_mod import :: psb_ipk_, psb_lpk_, psb_zspmat_type character(len=*), intent(in) :: fname class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) end subroutine psb_z_n_sparse_print end interface diff --git a/base/modules/serial/psb_z_serial_mod.f90 b/base/modules/serial/psb_z_serial_mod.f90 index 5afbcf96..dbfce00b 100644 --- a/base/modules/serial/psb_z_serial_mod.f90 +++ b/base/modules/serial/psb_z_serial_mod.f90 @@ -292,9 +292,9 @@ contains use psb_z_mat_mod, only : psb_zspmat_type integer(psb_ipk_), intent(in) :: iout type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(iout,iv,head,ivr,ivc) @@ -304,9 +304,9 @@ contains use psb_z_mat_mod, only : psb_zspmat_type character(len=*), intent(in) :: fname type(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:),ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:),ivc(:) call a%print(fname,iv,head,ivr,ivc) diff --git a/base/serial/impl/psb_c_coo_impl.F90 b/base/serial/impl/psb_c_coo_impl.F90 index f43a1fce..347c87d9 100644 --- a/base/serial/impl/psb_c_coo_impl.F90 +++ b/base/serial/impl/psb_c_coo_impl.F90 @@ -483,17 +483,15 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_c_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='c_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -505,38 +503,29 @@ subroutine psb_c_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -4871,9 +4860,8 @@ subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='lc_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -4885,38 +4873,29 @@ subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index f7df614a..d04d5fbf 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -2706,18 +2706,16 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_c_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csc_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2730,47 +2728,37 @@ subroutine psb_c_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -4561,13 +4549,10 @@ subroutine psb_lc_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='lc_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4580,47 +4565,38 @@ subroutine psb_lc_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index 1b3e9705..15f52a37 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -2750,21 +2750,21 @@ end subroutine psb_c_csr_trim subroutine psb_c_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_c_base_mat_mod use psb_c_csr_mat_mod, psb_protect_name => psb_c_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_c_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='c_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2777,47 +2777,38 @@ subroutine psb_c_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_c_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4886,9 +4877,8 @@ subroutine psb_lc_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='lc_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4901,47 +4891,38 @@ subroutine psb_lc_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lc_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 60f0fd3d..54f56eee 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_c_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_c_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_cspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen diff --git a/base/serial/impl/psb_d_coo_impl.F90 b/base/serial/impl/psb_d_coo_impl.F90 index c28cee8a..de04a136 100644 --- a/base/serial/impl/psb_d_coo_impl.F90 +++ b/base/serial/impl/psb_d_coo_impl.F90 @@ -483,17 +483,15 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_d_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='d_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -505,38 +503,29 @@ subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -4871,9 +4860,8 @@ subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='ld_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -4885,38 +4873,29 @@ subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index a8dcb76f..63dabf1e 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -2706,18 +2706,16 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_d_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csc_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2730,47 +2728,37 @@ subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -4561,13 +4549,10 @@ subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='ld_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4580,47 +4565,38 @@ subroutine psb_ld_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index a0fe923f..f264db26 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -2750,21 +2750,21 @@ end subroutine psb_d_csr_trim subroutine psb_d_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_d_base_mat_mod use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_d_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='d_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2777,47 +2777,38 @@ subroutine psb_d_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_d_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4886,9 +4877,8 @@ subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='ld_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4901,47 +4891,38 @@ subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ld_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 49d66499..cc65a010 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_d_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_d_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_dspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen diff --git a/base/serial/impl/psb_s_coo_impl.F90 b/base/serial/impl/psb_s_coo_impl.F90 index b09d5564..fffc3bf4 100644 --- a/base/serial/impl/psb_s_coo_impl.F90 +++ b/base/serial/impl/psb_s_coo_impl.F90 @@ -483,17 +483,15 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_s_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='s_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -505,38 +503,29 @@ subroutine psb_s_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -4871,9 +4860,8 @@ subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='ls_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -4885,38 +4873,29 @@ subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index ea7dd517..ffa84d41 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -2706,18 +2706,16 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_s_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csc_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2730,47 +2728,37 @@ subroutine psb_s_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -4561,13 +4549,10 @@ subroutine psb_ls_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='ls_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4580,47 +4565,38 @@ subroutine psb_ls_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 575d7678..a041302f 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -2750,21 +2750,21 @@ end subroutine psb_s_csr_trim subroutine psb_s_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_s_base_mat_mod use psb_s_csr_mat_mod, psb_protect_name => psb_s_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_s_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='s_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -2777,47 +2777,38 @@ subroutine psb_s_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_s_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4886,9 +4877,8 @@ subroutine psb_ls_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='ls_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='real' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate real general' @@ -4901,47 +4891,38 @@ subroutine psb_ls_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_ls_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index b05bd9cb..e79348c6 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_s_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_s_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_sspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen diff --git a/base/serial/impl/psb_z_coo_impl.F90 b/base/serial/impl/psb_z_coo_impl.F90 index cf54ce60..da8f2a1a 100644 --- a/base/serial/impl/psb_z_coo_impl.F90 +++ b/base/serial/impl/psb_z_coo_impl.F90 @@ -483,17 +483,15 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_z_coo_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='z_coo_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -505,38 +503,29 @@ subroutine psb_z_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif @@ -4871,9 +4860,8 @@ subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc) character(len=20) :: name='lz_coo_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' if (present(head)) write(iout,'(a,a)') '% ',head @@ -4885,38 +4873,29 @@ subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do j=1,a%get_nzeros() - write(iout,frmtv) iv(a%ia(j)),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(a%ja(j)),a%val(j) enddo else if (present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),a%ja(j),a%val(j) + write(iout,frmt) ivr(a%ia(j)),a%ja(j),a%val(j) enddo else if (present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),ivc(a%ja(j)),a%val(j) + write(iout,frmt) a%ia(j),ivc(a%ja(j)),a%val(j) enddo else if (.not.present(ivr).and..not.present(ivc)) then do j=1,a%get_nzeros() - write(iout,frmtv) a%ia(j),a%ja(j),a%val(j) + write(iout,frmt) a%ia(j),a%ja(j),a%val(j) enddo endif endif diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 54212ddb..d4c242df 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -2706,18 +2706,16 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_z_csc_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csc_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2730,47 +2728,37 @@ subroutine psb_z_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif @@ -4561,13 +4549,10 @@ subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc) integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ierr(5) character(len=20) :: name='lz_csc_print' logical, parameter :: debug=.false. - - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4580,47 +4565,38 @@ subroutine psb_lz_csc_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) iv(a%ia(j)),iv(i),a%val(j) + write(iout,frmt) iv(a%ia(j)),iv(i),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),i,a%val(j) + write(iout,frmt) ivr(a%ia(j)),i,a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) ivr(a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) ivr(a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),ivc(i),a%val(j) + write(iout,frmt) (a%ia(j)),ivc(i),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nc do j=a%icp(i),a%icp(i+1)-1 - write(iout,frmtv) (a%ia(j)),(i),a%val(j) + write(iout,frmt) (a%ia(j)),(i),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 5c09ec36..a816ed13 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -2750,21 +2750,21 @@ end subroutine psb_z_csr_trim subroutine psb_z_csr_print(iout,a,iv,head,ivr,ivc) use psb_string_mod + use psb_z_base_mat_mod use psb_z_csr_mat_mod, psb_protect_name => psb_z_csr_print implicit none integer(psb_ipk_), intent(in) :: iout class(psb_z_csr_sparse_mat), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act character(len=20) :: name='z_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_ipk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_ipk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -2777,47 +2777,38 @@ subroutine psb_z_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_z_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif @@ -4886,9 +4877,8 @@ subroutine psb_lz_csr_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_) :: err_act character(len=20) :: name='lz_csr_print' logical, parameter :: debug=.false. - character(len=*), parameter :: datatype='complex' - character(len=80) :: frmtv - integer(psb_lpk_) :: irs,ics,i,j, nmx, ni, nr, nc, nz + character(len=80) :: frmt + integer(psb_lpk_) :: irs,ics,i,j, ni, nr, nc, nz write(iout,'(a)') '%%MatrixMarket matrix coordinate complex general' @@ -4901,47 +4891,38 @@ subroutine psb_lz_csr_print(iout,a,iv,head,ivr,ivc) nr = a%get_nrows() nc = a%get_ncols() nz = a%get_nzeros() - nmx = max(nr,nc,1) - if (present(iv)) nmx = max(nmx,maxval(abs(iv))) - if (present(ivr)) nmx = max(nmx,maxval(abs(ivr))) - if (present(ivc)) nmx = max(nmx,maxval(abs(ivc))) - ni = floor(log10(1.0*nmx)) + 1 - - if (datatype=='real') then - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),es26.18,1x,2(i',ni,',1x))' - else - write(frmtv,'(a,i3.3,a,i3.3,a)') '(2(i',ni,',1x),2(es26.18,1x),2(i',ni,',1x))' - end if + frmt = psb_lz_get_print_frmt(nr,nc,nz,iv,ivr,ivc) + write(iout,*) nr, nc, nz if(present(iv)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) iv(i),iv(a%ja(j)),a%val(j) + write(iout,frmt) iv(i),iv(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),(a%ja(j)),a%val(j) end do enddo else if (present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) ivr(i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) ivr(i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),ivc(a%ja(j)),a%val(j) + write(iout,frmt) (i),ivc(a%ja(j)),a%val(j) end do enddo else if (.not.present(ivr).and..not.present(ivc)) then do i=1, nr do j=a%irp(i),a%irp(i+1)-1 - write(iout,frmtv) (i),(a%ja(j)),a%val(j) + write(iout,frmt) (i),(a%ja(j)),a%val(j) end do enddo endif diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 8eac4f8f..0a18563a 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -466,9 +466,9 @@ subroutine psb_z_sparse_print(iout,a,iv,head,ivr,ivc) integer(psb_ipk_), intent(in) :: iout class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info character(len=20) :: name='sparse_print' @@ -500,9 +500,9 @@ subroutine psb_z_n_sparse_print(fname,a,iv,head,ivr,ivc) character(len=*), intent(in) :: fname class(psb_zspmat_type), intent(in) :: a - integer(psb_ipk_), intent(in), optional :: iv(:) + integer(psb_lpk_), intent(in), optional :: iv(:) character(len=*), optional :: head - integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:) + integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:) integer(psb_ipk_) :: err_act, info, iout logical :: isopen