fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Change mat%print interface, and refactor.

Browse Source
pizdaint-runs
Salvatore Filippone 5 years ago
parent d3e4a091e8
commit 01ffca76d2
37 changed files with 531 additions and 579 deletions
Show Stats Download Patch File Download Diff File

6
base/modules/serial/psb_base_mat_mod.F90
Unescape Escape View File

@ -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

60
base/modules/serial/psb_c_base_mat_mod.F90
Unescape Escape View File

@ -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
! == ==================================
!

4
base/modules/serial/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -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

4
base/modules/serial/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -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
!

8
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -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

8
base/modules/serial/psb_c_serial_mod.f90
Unescape Escape View File

@ -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)

60
base/modules/serial/psb_d_base_mat_mod.F90
Unescape Escape View File

@ -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
! == ==================================
!

4
base/modules/serial/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -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

4
base/modules/serial/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -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
!

8
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -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

8
base/modules/serial/psb_d_serial_mod.f90
Unescape Escape View File

@ -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)

60
base/modules/serial/psb_s_base_mat_mod.F90
Unescape Escape View File

@ -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
! == ==================================
!

4
base/modules/serial/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -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

4
base/modules/serial/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -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
!

8
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -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

8
base/modules/serial/psb_s_serial_mod.f90
Unescape Escape View File

@ -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)

60
base/modules/serial/psb_z_base_mat_mod.F90
Unescape Escape View File

@ -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
! == ==================================
!

4
base/modules/serial/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -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

4
base/modules/serial/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -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
!

8
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -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

8
base/modules/serial/psb_z_serial_mod.f90
Unescape Escape View File

@ -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)

61
base/serial/impl/psb_c_coo_impl.F90
Unescape Escape View File

@ -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

62
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -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

8
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_d_coo_impl.F90
Unescape Escape View File

@ -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

62
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -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

8
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_s_coo_impl.F90
Unescape Escape View File

@ -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

62
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -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

8
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_z_coo_impl.F90
Unescape Escape View File

@ -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

62
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -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

61
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -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

8
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save