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

New version with (limited) LX folded into X files.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 7d10c2df2f
commit 13ded391b4
46 changed files with 28970 additions and 3044 deletions
Show Stats Download Patch File Download Diff File

23
base/modules/Makefile
Unescape Escape View File

@ -98,6 +98,8 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m
serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_mat_mod.o \
serial/psb_z_base_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_z_csc_mat_mod.o serial/psb_z_mat_mod.o
#\
# serial/psb_ls_csr_mat_mod.o serial/psb_ld_csr_mat_mod.o serial/psb_lc_csr_mat_mod.o serial/psb_lz_csr_mat_mod.o
#\
# serial/psb_ld_base_mat_mod.o serial/psb_lbase_mat_mod.o serial/psb_ld_csc_mat_mod.o serial/psb_ld_csr_mat_mod.o
@ -209,15 +211,18 @@ serial/psb_z_base_mat_mod.o: serial/psb_z_base_vect_mod.o
serial/psb_l_base_vect_mod.o: serial/psb_i_base_vect_mod.o
serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o
serial/psb_i_base_vect_mod.o serial/psb_l_base_vect_mod.o serial/psb_c_base_vect_mod.o serial/psb_s_base_vect_mod.o serial/psb_d_base_vect_mod.o serial/psb_z_base_vect_mod.o: auxil/psi_serial_mod.o psb_realloc_mod.o
serial/psb_s_mat_mod.o: serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_vect_mod.o
serial/psb_d_mat_mod.o: serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_vect_mod.o serial/psb_i_vect_mod.o
#serial/psb_d_mat_mod.o: serial/psb_ld_base_mat_mod.o
serial/psb_c_mat_mod.o: serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_vect_mod.o
serial/psb_z_mat_mod.o: serial/psb_z_base_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_z_csc_mat_mod.o serial/psb_z_vect_mod.o
serial/psb_s_csc_mat_mod.o serial/psb_s_csr_mat_mod.o: serial/psb_s_base_mat_mod.o
serial/psb_d_csc_mat_mod.o serial/psb_d_csr_mat_mod.o: serial/psb_d_base_mat_mod.o
serial/psb_c_csc_mat_mod.o serial/psb_c_csr_mat_mod.o: serial/psb_c_base_mat_mod.o
serial/psb_z_csc_mat_mod.o serial/psb_z_csr_mat_mod.o: serial/psb_z_base_mat_mod.o
serial/psb_s_mat_mod.o: serial/psb_s_base_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_s_csc_mat_mod.o serial/psb_s_vect_mod.o \
serial/psb_i_vect_mod.o
serial/psb_d_mat_mod.o: serial/psb_d_base_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_d_csc_mat_mod.o serial/psb_d_vect_mod.o \
serial/psb_i_vect_mod.o
serial/psb_c_mat_mod.o: serial/psb_c_base_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_c_csc_mat_mod.o serial/psb_c_vect_mod.o \
serial/psb_i_vect_mod.o
serial/psb_z_mat_mod.o: serial/psb_z_base_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_z_csc_mat_mod.o serial/psb_z_vect_mod.o \
serial/psb_i_vect_mod.o
serial/psb_s_csc_mat_mod.o serial/psb_s_csr_mat_mod.o serial/psb_ls_csr_mat_mod.o: serial/psb_s_base_mat_mod.o
serial/psb_d_csc_mat_mod.o serial/psb_d_csr_mat_mod.o serial/psb_ld_csr_mat_mod.o: serial/psb_d_base_mat_mod.o
serial/psb_c_csc_mat_mod.o serial/psb_c_csr_mat_mod.o serial/psb_lc_csr_mat_mod.o: serial/psb_c_base_mat_mod.o
serial/psb_z_csc_mat_mod.o serial/psb_z_csr_mat_mod.o serial/psb_lz_csr_mat_mod.o: serial/psb_z_base_mat_mod.o
serial/psb_mat_mod.o: serial/psb_vect_mod.o serial/psb_s_mat_mod.o serial/psb_d_mat_mod.o serial/psb_c_mat_mod.o serial/psb_z_mat_mod.o
serial/psb_serial_mod.o: serial/psb_s_serial_mod.o serial/psb_d_serial_mod.o serial/psb_c_serial_mod.o serial/psb_z_serial_mod.o

180
base/modules/auxil/psb_c_ip_reord_mod.F90
Unescape Escape View File

@ -40,20 +40,23 @@ module psb_c_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_c1,&
& psb_ip_reord_c1i1, psb_ip_reord_c1i2,&
& psb_ip_reord_c1i3
module procedure psb_ip_reord_c1m,&
& psb_ip_reord_c1m1, psb_ip_reord_c1m2,&
& psb_ip_reord_c1m3
module procedure psb_ip_reord_c1e,&
& psb_ip_reord_c1e1, psb_ip_reord_c1e2,&
& psb_ip_reord_c1e3
end interface
contains
subroutine psb_ip_reord_c1(n,x,iaux)
subroutine psb_ip_reord_c1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_ipk_) :: lswap, lp, k
integer(psb_mpk_) :: lswap, lp, k
complex(psb_spk_) :: swap
lp = iaux(0)
@ -74,14 +77,14 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1
end subroutine psb_ip_reord_c1m
subroutine psb_ip_reord_c1i1(n,x,indx,iaux)
subroutine psb_ip_reord_c1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_ipk_) :: indx(*)
integer(psb_ipk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
complex(psb_spk_) :: swap
lp = iaux(0)
@ -105,16 +108,16 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1i1
end subroutine psb_ip_reord_c1m1
subroutine psb_ip_reord_c1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_c1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
complex(psb_spk_) :: swap
lp = iaux(0)
@ -141,15 +144,15 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1i2
end subroutine psb_ip_reord_c1m2
subroutine psb_ip_reord_c1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_c1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
complex(psb_spk_) :: swap
lp = iaux(0)
@ -179,6 +182,139 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1i3
end subroutine psb_ip_reord_c1m3
subroutine psb_ip_reord_c1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_epk_) :: lswap, lp, k
complex(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1e
subroutine psb_ip_reord_c1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_epk_) :: indx(*)
integer(psb_epk_) :: lswap, lp, k, ixswap
complex(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1e1
subroutine psb_ip_reord_c1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2
complex(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1e2
subroutine psb_ip_reord_c1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_spk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*), i3(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3
complex(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_c1e3
end module psb_c_ip_reord_mod

180
base/modules/auxil/psb_d_ip_reord_mod.F90
Unescape Escape View File

@ -40,20 +40,23 @@ module psb_d_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_d1,&
& psb_ip_reord_d1i1, psb_ip_reord_d1i2,&
& psb_ip_reord_d1i3
module procedure psb_ip_reord_d1m,&
& psb_ip_reord_d1m1, psb_ip_reord_d1m2,&
& psb_ip_reord_d1m3
module procedure psb_ip_reord_d1e,&
& psb_ip_reord_d1e1, psb_ip_reord_d1e2,&
& psb_ip_reord_d1e3
end interface
contains
subroutine psb_ip_reord_d1(n,x,iaux)
subroutine psb_ip_reord_d1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_ipk_) :: lswap, lp, k
integer(psb_mpk_) :: lswap, lp, k
real(psb_dpk_) :: swap
lp = iaux(0)
@ -74,14 +77,14 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1
end subroutine psb_ip_reord_d1m
subroutine psb_ip_reord_d1i1(n,x,indx,iaux)
subroutine psb_ip_reord_d1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_ipk_) :: indx(*)
integer(psb_ipk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
real(psb_dpk_) :: swap
lp = iaux(0)
@ -105,16 +108,16 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1i1
end subroutine psb_ip_reord_d1m1
subroutine psb_ip_reord_d1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_d1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
real(psb_dpk_) :: swap
lp = iaux(0)
@ -141,15 +144,15 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1i2
end subroutine psb_ip_reord_d1m2
subroutine psb_ip_reord_d1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_d1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
real(psb_dpk_) :: swap
lp = iaux(0)
@ -179,6 +182,139 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1i3
end subroutine psb_ip_reord_d1m3
subroutine psb_ip_reord_d1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_epk_) :: lswap, lp, k
real(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1e
subroutine psb_ip_reord_d1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_epk_) :: indx(*)
integer(psb_epk_) :: lswap, lp, k, ixswap
real(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1e1
subroutine psb_ip_reord_d1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2
real(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1e2
subroutine psb_ip_reord_d1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_dpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*), i3(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3
real(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_d1e3
end module psb_d_ip_reord_mod

160
base/modules/auxil/psb_e_ip_reord_mod.F90
Unescape Escape View File

@ -40,16 +40,152 @@ module psb_e_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_e1,&
& psb_ip_reord_e1i1, psb_ip_reord_e1i2,&
& psb_ip_reord_e1i3
module procedure psb_ip_reord_e1m,&
& psb_ip_reord_e1m1, psb_ip_reord_e1m2,&
& psb_ip_reord_e1m3
module procedure psb_ip_reord_e1e,&
& psb_ip_reord_e1e1, psb_ip_reord_e1e2,&
& psb_ip_reord_e1e3
end interface
contains
subroutine psb_ip_reord_e1(n,x,iaux)
subroutine psb_ip_reord_e1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
integer(psb_mpk_) :: lswap, lp, k
integer(psb_epk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1m
subroutine psb_ip_reord_e1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
integer(psb_epk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1m1
subroutine psb_ip_reord_e1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
integer(psb_epk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1m2
subroutine psb_ip_reord_e1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_mpk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_epk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1m3
subroutine psb_ip_reord_e1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
@ -74,9 +210,9 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1
end subroutine psb_ip_reord_e1e
subroutine psb_ip_reord_e1i1(n,x,indx,iaux)
subroutine psb_ip_reord_e1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
@ -105,9 +241,9 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1i1
end subroutine psb_ip_reord_e1e1
subroutine psb_ip_reord_e1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_e1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
@ -141,9 +277,9 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1i2
end subroutine psb_ip_reord_e1e2
subroutine psb_ip_reord_e1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_e1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_epk_) :: x(*)
@ -179,6 +315,6 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_e1i3
end subroutine psb_ip_reord_e1e3
end module psb_e_ip_reord_mod

180
base/modules/auxil/psb_m_ip_reord_mod.F90
Unescape Escape View File

@ -40,20 +40,23 @@ module psb_m_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_m1,&
& psb_ip_reord_m1i1, psb_ip_reord_m1i2,&
& psb_ip_reord_m1i3
module procedure psb_ip_reord_m1m,&
& psb_ip_reord_m1m1, psb_ip_reord_m1m2,&
& psb_ip_reord_m1m3
module procedure psb_ip_reord_m1e,&
& psb_ip_reord_m1e1, psb_ip_reord_m1e2,&
& psb_ip_reord_m1e3
end interface
contains
subroutine psb_ip_reord_m1(n,x,iaux)
subroutine psb_ip_reord_m1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_ipk_) :: lswap, lp, k
integer(psb_mpk_) :: lswap, lp, k
integer(psb_mpk_) :: swap
lp = iaux(0)
@ -74,14 +77,14 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1
end subroutine psb_ip_reord_m1m
subroutine psb_ip_reord_m1i1(n,x,indx,iaux)
subroutine psb_ip_reord_m1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_ipk_) :: indx(*)
integer(psb_ipk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: swap
lp = iaux(0)
@ -105,16 +108,16 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1i1
end subroutine psb_ip_reord_m1m1
subroutine psb_ip_reord_m1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_m1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: swap
lp = iaux(0)
@ -141,15 +144,15 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1i2
end subroutine psb_ip_reord_m1m2
subroutine psb_ip_reord_m1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_m1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: swap
lp = iaux(0)
@ -179,6 +182,139 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1i3
end subroutine psb_ip_reord_m1m3
subroutine psb_ip_reord_m1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_epk_) :: lswap, lp, k
integer(psb_mpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1e
subroutine psb_ip_reord_m1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_epk_) :: indx(*)
integer(psb_epk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1e1
subroutine psb_ip_reord_m1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1e2
subroutine psb_ip_reord_m1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
integer(psb_mpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*), i3(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_m1e3
end module psb_m_ip_reord_mod

180
base/modules/auxil/psb_s_ip_reord_mod.F90
Unescape Escape View File

@ -40,20 +40,23 @@ module psb_s_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_s1,&
& psb_ip_reord_s1i1, psb_ip_reord_s1i2,&
& psb_ip_reord_s1i3
module procedure psb_ip_reord_s1m,&
& psb_ip_reord_s1m1, psb_ip_reord_s1m2,&
& psb_ip_reord_s1m3
module procedure psb_ip_reord_s1e,&
& psb_ip_reord_s1e1, psb_ip_reord_s1e2,&
& psb_ip_reord_s1e3
end interface
contains
subroutine psb_ip_reord_s1(n,x,iaux)
subroutine psb_ip_reord_s1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_ipk_) :: lswap, lp, k
integer(psb_mpk_) :: lswap, lp, k
real(psb_spk_) :: swap
lp = iaux(0)
@ -74,14 +77,14 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1
end subroutine psb_ip_reord_s1m
subroutine psb_ip_reord_s1i1(n,x,indx,iaux)
subroutine psb_ip_reord_s1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_ipk_) :: indx(*)
integer(psb_ipk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
real(psb_spk_) :: swap
lp = iaux(0)
@ -105,16 +108,16 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1i1
end subroutine psb_ip_reord_s1m1
subroutine psb_ip_reord_s1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_s1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
real(psb_spk_) :: swap
lp = iaux(0)
@ -141,15 +144,15 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1i2
end subroutine psb_ip_reord_s1m2
subroutine psb_ip_reord_s1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_s1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
real(psb_spk_) :: swap
lp = iaux(0)
@ -179,6 +182,139 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1i3
end subroutine psb_ip_reord_s1m3
subroutine psb_ip_reord_s1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_epk_) :: lswap, lp, k
real(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1e
subroutine psb_ip_reord_s1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_epk_) :: indx(*)
integer(psb_epk_) :: lswap, lp, k, ixswap
real(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1e1
subroutine psb_ip_reord_s1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2
real(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1e2
subroutine psb_ip_reord_s1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
real(psb_spk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*), i3(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3
real(psb_spk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_s1e3
end module psb_s_ip_reord_mod

180
base/modules/auxil/psb_z_ip_reord_mod.F90
Unescape Escape View File

@ -40,20 +40,23 @@ module psb_z_ip_reord_mod
use psb_const_mod
interface psb_ip_reord
module procedure psb_ip_reord_z1,&
& psb_ip_reord_z1i1, psb_ip_reord_z1i2,&
& psb_ip_reord_z1i3
module procedure psb_ip_reord_z1m,&
& psb_ip_reord_z1m1, psb_ip_reord_z1m2,&
& psb_ip_reord_z1m3
module procedure psb_ip_reord_z1e,&
& psb_ip_reord_z1e1, psb_ip_reord_z1e2,&
& psb_ip_reord_z1e3
end interface
contains
subroutine psb_ip_reord_z1(n,x,iaux)
subroutine psb_ip_reord_z1m(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_ipk_) :: lswap, lp, k
integer(psb_mpk_) :: lswap, lp, k
complex(psb_dpk_) :: swap
lp = iaux(0)
@ -74,14 +77,14 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1
end subroutine psb_ip_reord_z1m
subroutine psb_ip_reord_z1i1(n,x,indx,iaux)
subroutine psb_ip_reord_z1m1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_ipk_) :: indx(*)
integer(psb_ipk_) :: lswap, lp, k, ixswap
integer(psb_mpk_) :: indx(*)
integer(psb_mpk_) :: lswap, lp, k, ixswap
complex(psb_dpk_) :: swap
lp = iaux(0)
@ -105,16 +108,16 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1i1
end subroutine psb_ip_reord_z1m1
subroutine psb_ip_reord_z1i2(n,x,i1,i2,iaux)
subroutine psb_ip_reord_z1m2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*)
integer(psb_mpk_) :: i1(*), i2(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2
complex(psb_dpk_) :: swap
lp = iaux(0)
@ -141,15 +144,15 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1i2
end subroutine psb_ip_reord_z1m2
subroutine psb_ip_reord_z1i3(n,x,i1,i2,i3,iaux)
subroutine psb_ip_reord_z1m3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: iaux(0:*)
integer(psb_mpk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_ipk_) :: i1(*), i2(*), i3(*)
integer(psb_mpk_) :: i1(*), i2(*), i3(*)
integer(psb_ipk_) :: lswap, lp, k, isw1, isw2, isw3
integer(psb_mpk_) :: lswap, lp, k, isw1, isw2, isw3
complex(psb_dpk_) :: swap
lp = iaux(0)
@ -179,6 +182,139 @@ contains
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1i3
end subroutine psb_ip_reord_z1m3
subroutine psb_ip_reord_z1e(n,x,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_epk_) :: lswap, lp, k
complex(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1e
subroutine psb_ip_reord_z1e1(n,x,indx,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_epk_) :: indx(*)
integer(psb_epk_) :: lswap, lp, k, ixswap
complex(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1e1
subroutine psb_ip_reord_z1e2(n,x,i1,i2,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2
complex(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1e2
subroutine psb_ip_reord_z1e3(n,x,i1,i2,i3,iaux)
integer(psb_ipk_), intent(in) :: n
integer(psb_epk_) :: iaux(0:*)
complex(psb_dpk_) :: x(*)
integer(psb_epk_) :: i1(*), i2(*), i3(*)
integer(psb_epk_) :: lswap, lp, k, isw1, isw2, isw3
complex(psb_dpk_) :: swap
lp = iaux(0)
k = 1
do
if ((lp == 0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
isw1 = i1(lp)
i1(lp) = i1(k)
i1(k) = isw1
isw2 = i2(lp)
i2(lp) = i2(k)
i2(k) = isw2
isw3 = i3(lp)
i3(lp) = i3(k)
i3(k) = isw3
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
return
end subroutine psb_ip_reord_z1e3
end module psb_z_ip_reord_mod

822
base/modules/serial/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -276,6 +276,9 @@ module psb_c_base_mat_mod
procedure, pass(a) :: clone => psb_lc_base_clone
procedure, pass(a) :: make_nonunit => psb_lc_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lc_base_clean_zeros
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
!
! Convert internal indices
!
@ -296,31 +299,6 @@ module psb_c_base_mat_mod
procedure, pass(a) :: transc_1mat => psb_lc_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lc_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lc_base_vect_mv
procedure, pass(a) :: csmv => psb_lc_base_csmv
procedure, pass(a) :: csmm => psb_lc_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lc_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lc_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lc_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lc_base_vect_cssv
procedure, pass(a) :: cssv => psb_lc_base_cssv
procedure, pass(a) :: cssm => psb_lc_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lc_base_maxval
procedure, pass(a) :: spnmi => psb_lc_base_csnmi
procedure, pass(a) :: spnm1 => psb_lc_base_csnm1
procedure, pass(a) :: rowsum => psb_lc_base_rowsum
procedure, pass(a) :: arwsum => psb_lc_base_arwsum
procedure, pass(a) :: colsum => psb_lc_base_colsum
procedure, pass(a) :: aclsum => psb_lc_base_aclsum
end type psb_lc_base_sparse_mat
private :: lc_base_mat_sync, lc_base_mat_is_host, lc_base_mat_is_dev, &
@ -388,6 +366,8 @@ module psb_c_base_mat_mod
procedure, pass(a) :: set_by_cols => lc_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lc_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lc_coo_get_sort_status
procedure, pass(a) :: scals => psb_lc_coo_scals
procedure, pass(a) :: scalv => psb_lc_coo_scal
!
! This is COO specific
@ -402,22 +382,6 @@ module psb_c_base_mat_mod
procedure, pass(a) :: transp_1mat => lc_coo_transp_1mat
procedure, pass(a) :: transc_1mat => lc_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_lc_coo_csmm
procedure, pass(a) :: csmv => psb_lc_coo_csmv
procedure, pass(a) :: inner_cssm => psb_lc_coo_cssm
procedure, pass(a) :: inner_cssv => psb_lc_coo_cssv
procedure, pass(a) :: scals => psb_lc_coo_scals
procedure, pass(a) :: scalv => psb_lc_coo_scal
procedure, pass(a) :: maxval => psb_lc_coo_maxval
procedure, pass(a) :: spnmi => psb_lc_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lc_coo_csnm1
procedure, pass(a) :: rowsum => psb_lc_coo_rowsum
procedure, pass(a) :: arwsum => psb_lc_coo_arwsum
procedure, pass(a) :: colsum => psb_lc_coo_colsum
procedure, pass(a) :: aclsum => psb_lc_coo_aclsum
end type psb_lc_coo_sparse_mat
@ -2756,6 +2720,43 @@ module psb_c_base_mat_mod
end subroutine psb_lc_base_clean_zeros
end interface
!
!> Function base_scals:
!! \memberof psb_lc_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lc_base_scals(d,a,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_lc_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_lc_base_scal(d,a,info,side)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lc_base_scal
end interface
!
!> Function transp:
!! \memberof psb_lc_base_sparse_mat
@ -2816,554 +2817,119 @@ module psb_c_base_mat_mod
end subroutine psb_lc_base_transc_1mat
end interface
! == ===============
!
!> Function csmm:
!! \memberof psb_lc_base_sparse_mat
!! \brief Product by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
! COO interfaces
!
interface
subroutine psb_lc_base_csmm(alpha,a,x,beta,y,info,trans)
! == ===============
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_lc_coo_reallocate_nz(nz,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_csmm
integer(psb_lpk_), intent(in) :: nz
class(psb_lc_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lc_coo_reallocate_nz
end interface
!> Function csmv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Product by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_lc_base_csmv(alpha,a,x,beta,y,info,trans)
subroutine psb_lc_coo_reinit(a,clear)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_csmv
class(psb_lc_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lc_coo_reinit
end interface
!> Function vect_mv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Product by an encapsulated array type(psb_lc_vect_type)
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!! Usually the unwrapping of the encapsulated vector is done
!! here, so that all the derived classes need only the
!! versions with the standard arrays.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input X
!! \param beta Scaling factor for y
!! \param y the input/output Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_lc_base_vect_mv(alpha,a,x,beta,y,info,trans)
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_lc_coo_trim(a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y
class(psb_lc_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lc_coo_trim
end interface
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros
!
interface
subroutine psb_lc_coo_clean_zeros(a,info)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_vect_mv
end subroutine psb_lc_coo_clean_zeros
end interface
!
!> Function cssm:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssm.
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_lc_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lc_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lc_coo_allocate_mnnz
end interface
!> \memberof psb_lc_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lc_base_inner_cssm(alpha,a,x,beta,y,info,trans)
subroutine psb_lc_coo_mold(a,b,info)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_inner_cssm
class(psb_lc_coo_sparse_mat), intent(in) :: a
class(psb_lc_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_coo_mold
end interface
!
!> Function cssv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssv.
!> Function print.
!! \memberof psb_lc_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_lc_base_inner_cssv(alpha,a,x,beta,y,info,trans)
interface
subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_inner_cssv
integer(psb_ipk_), intent(in) :: iout
class(psb_lc_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lc_coo_print
end interface
!
!> Function inner_vect_cssv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_lc_vect_type)
!> Function get_nz_row.
!! \memberof psb_lc_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by vect_cssv.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!
interface
subroutine psb_lc_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_base_inner_vect_sv
end interface
!
!> Function cssm:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lc_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_spk_), intent(in), optional :: d(:)
end subroutine psb_lc_base_cssm
end interface
!
!> Function cssv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lc_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_spk_), intent(in), optional :: d(:)
end subroutine psb_lc_base_cssv
end interface
!
!> Function vect_cssv:
!! \memberof psb_lc_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_lc_vect_type)
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lc_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta
class(psb_c_base_vect_type), intent(inout) :: x,y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
class(psb_c_base_vect_type), optional, intent(inout) :: d
end subroutine psb_lc_base_vect_cssv
end interface
!
!> Function base_scals:
!! \memberof psb_lc_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lc_base_scals(d,a,info)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_lc_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_lc_base_scal(d,a,info,side)
import
class(psb_lc_base_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lc_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_lc_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_lc_base_maxval(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lc_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_lc_base_csnmi(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lc_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_lc_base_csnm1(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_lc_base_rowsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_lc_base_arwsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_lc_base_colsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_lc_base_aclsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_aclsum
end interface
! == ===============
!
! COO interfaces
!
! == ===============
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_lc_coo_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_lc_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lc_coo_reallocate_nz
end interface
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_lc_coo_reinit(a,clear)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lc_coo_reinit
end interface
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_lc_coo_trim(a)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lc_coo_trim
end interface
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_clean_zeros
!
interface
subroutine psb_lc_coo_clean_zeros(a,info)
import
class(psb_lc_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_coo_clean_zeros
end interface
!
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_lc_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lc_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lc_coo_allocate_mnnz
end interface
!> \memberof psb_lc_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lc_coo_mold(a,b,info)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
class(psb_lc_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_coo_mold
end interface
!
!> Function print.
!! \memberof psb_lc_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_lc_coo_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_lc_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lc_coo_print
end interface
!
!> Function get_nz_row.
!! \memberof psb_lc_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! \param idx The row to search.
!! \param idx The row to search.
!!
!
interface
@ -3627,138 +3193,6 @@ module psb_c_base_mat_mod
end subroutine psb_lc_coo_csgetrow
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cssv
interface
subroutine psb_lc_coo_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_coo_cssv
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cssm
interface
subroutine psb_lc_coo_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_coo_cssm
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csmv
interface
subroutine psb_lc_coo_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:)
complex(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_coo_csmv
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csmm
interface
subroutine psb_lc_coo_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lc_coo_csmm
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_maxval
interface
function psb_lc_coo_maxval(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_maxval
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csnmi
interface
function psb_lc_coo_csnmi(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_csnmi
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csnm1
interface
function psb_lc_coo_csnm1(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_csnm1
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_rowsum
interface
subroutine psb_lc_coo_rowsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_rowsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_arwsum
interface
subroutine psb_lc_coo_arwsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_arwsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_colsum
interface
subroutine psb_lc_coo_colsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_colsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_aclsum
interface
subroutine psb_lc_coo_aclsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_aclsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_get_diag
@ -3771,6 +3205,7 @@ module psb_c_base_mat_mod
end subroutine psb_lc_coo_get_diag
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scal
@ -3796,7 +3231,6 @@ module psb_c_base_mat_mod
end subroutine psb_lc_coo_scals
end interface
contains
@ -3818,7 +3252,7 @@ contains
implicit none
class(psb_c_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_ip
res = res + (2*psb_sizeof_sp) * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%ia)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -4042,7 +3476,7 @@ contains
implicit none
class(psb_lc_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_lp
res = res + (2*psb_sizeof_sp) * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%ia)
res = res + psb_sizeof_lp * psb_size(a%ja)

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

@ -495,6 +495,334 @@ module psb_c_csr_mat_mod
end interface
!> \namespace psb_base_mod \class psb_lc_csr_sparse_mat
!! \extends psb_lc_base_mat_mod::psb_lc_base_sparse_mat
!!
!! psb_lc_csr_sparse_mat type and the related methods.
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_lc_base_sparse_mat) :: psb_lc_csr_sparse_mat
!> Pointers to beginning of rows in JA and VAL.
integer(psb_lpk_), allocatable :: irp(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_spk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_rows => lc_csr_is_by_rows
procedure, pass(a) :: get_size => lc_csr_get_size
procedure, pass(a) :: get_nzeros => lc_csr_get_nzeros
procedure, nopass :: get_fmt => lc_csr_get_fmt
procedure, pass(a) :: sizeof => lc_csr_sizeof
procedure, pass(a) :: reallocate_nz => psb_lc_csr_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lc_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lc_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => psb_lc_cp_csr_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lc_cp_csr_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lc_cp_csr_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lc_mv_csr_to_coo
procedure, pass(a) :: mv_from_coo => psb_lc_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lc_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_csr_from_fmt
procedure, pass(a) :: csput_a => psb_lc_csr_csput_a
procedure, pass(a) :: get_diag => psb_lc_csr_get_diag
procedure, pass(a) :: csgetptn => psb_lc_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_lc_csr_csgetrow
procedure, pass(a) :: get_nz_row => lc_csr_get_nz_row
procedure, pass(a) :: reinit => psb_lc_csr_reinit
procedure, pass(a) :: trim => psb_lc_csr_trim
procedure, pass(a) :: print => psb_lc_csr_print
procedure, pass(a) :: free => lc_csr_free
procedure, pass(a) :: mold => psb_lc_csr_mold
procedure, pass(a) :: scals => psb_lc_csr_scals
procedure, pass(a) :: scalv => psb_lc_csr_scal
end type psb_lc_csr_sparse_mat
private :: lc_csr_get_nzeros, lc_csr_free, lc_csr_get_fmt, &
& lc_csr_get_size, lc_csr_sizeof, lc_csr_get_nz_row, &
& lc_csr_is_by_rows
!> \memberof psb_lc_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_lc_csr_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_lc_csr_sparse_mat), intent(inout) :: a
end subroutine psb_lc_csr_reallocate_nz
end interface
!> \memberof psb_lc_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_lc_csr_reinit(a,clear)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lc_csr_reinit
end interface
!> \memberof psb_lc_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_lc_csr_trim(a)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
end subroutine psb_lc_csr_trim
end interface
!> \memberof psb_lc_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lc_csr_mold(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csr_mold
end interface
!> \memberof psb_lc_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_lc_csr_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lc_csr_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lc_csr_allocate_mnnz
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_print
interface
subroutine psb_lc_csr_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lc_csr_print
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_to_coo
interface
subroutine psb_lc_cp_csr_to_coo(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_csr_to_coo
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from_coo
interface
subroutine psb_lc_cp_csr_from_coo(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_csr_from_coo
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_to_fmt
interface
subroutine psb_lc_cp_csr_to_fmt(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_csr_to_fmt
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from_fmt
interface
subroutine psb_lc_cp_csr_from_fmt(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_cp_csr_from_fmt
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_mv_to_coo
interface
subroutine psb_lc_mv_csr_to_coo(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_mv_csr_to_coo
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_mv_from_coo
interface
subroutine psb_lc_mv_csr_from_coo(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_mv_csr_from_coo
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_mv_to_fmt
interface
subroutine psb_lc_mv_csr_to_fmt(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_mv_csr_to_fmt
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_mv_from_fmt
interface
subroutine psb_lc_mv_csr_from_fmt(a,b,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
class(psb_lc_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_mv_csr_from_fmt
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_cp_from
interface
subroutine psb_lc_csr_cp_from(a,b)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
type(psb_lc_csr_sparse_mat), intent(in) :: b
end subroutine psb_lc_csr_cp_from
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_mv_from
interface
subroutine psb_lc_csr_mv_from(a,b)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
type(psb_lc_csr_sparse_mat), intent(inout) :: b
end subroutine psb_lc_csr_mv_from
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csput_a
interface
subroutine psb_lc_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_lc_csr_csput_a
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_lc_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csr_csgetptn
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csgetrow
interface
subroutine psb_lc_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csr_csgetrow
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_csgetblk
interface
subroutine psb_lc_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lc_csr_csgetblk
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_get_diag
interface
subroutine psb_lc_csr_get_diag(a,d,info)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csr_get_diag
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scal
interface
subroutine psb_lc_csr_scal(d,a,info,side)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lc_csr_scal
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scals
interface
subroutine psb_lc_csr_scals(d,a,info)
import
class(psb_lc_csr_sparse_mat), intent(inout) :: a
complex(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csr_scals
end interface
contains
@ -525,7 +853,7 @@ contains
implicit none
class(psb_c_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = 2 * psb_sizeof_ip
res = res + (2*psb_sizeof_sp) * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%irp)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -614,4 +942,120 @@ contains
end subroutine c_csr_free
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function lc_csr_is_by_rows(a) result(res)
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function lc_csr_is_by_rows
function lc_csr_sizeof(a) result(res)
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 2 * psb_sizeof_lp
res = res + (2*psb_sizeof_sp) * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function lc_csr_sizeof
function lc_csr_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSR'
end function lc_csr_get_fmt
function lc_csr_get_nzeros(a) result(res)
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%irp(a%get_nrows()+1)-1
end function lc_csr_get_nzeros
function lc_csr_get_size(a) result(res)
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ja)) then
res = size(a%ja)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function lc_csr_get_size
function lc_csr_get_nz_row(idx,a) result(res)
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function lc_csr_get_nz_row
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine lc_csr_free(a)
implicit none
class(psb_lc_csr_sparse_mat), intent(inout) :: a
if (allocated(a%irp)) deallocate(a%irp)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine lc_csr_free
end module psb_c_csr_mat_mod

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

@ -72,8 +72,8 @@
module psb_c_mat_mod
use psb_c_base_mat_mod
use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat
use psb_c_csc_mat_mod, only : psb_c_csc_sparse_mat
use psb_c_csr_mat_mod, only : psb_c_csr_sparse_mat, psb_lc_csr_sparse_mat
use psb_c_csc_mat_mod, only : psb_c_csc_sparse_mat
type :: psb_cspmat_type

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

@ -203,6 +203,69 @@ module psb_c_serial_mod
end subroutine psb_c_aspxpby
end interface psb_aspxpby
interface psb_spspmm
!!$ subroutine psb_cspspmm(a,b,c,info)
!!$ use psb_c_mat_mod, only : psb_cspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_cspmat_type), intent(in) :: a,b
!!$ type(psb_cspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_cspspmm
subroutine psb_lccsrspspmm(a,b,c,info)
use psb_c_mat_mod, only : psb_lc_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a,b
type(psb_lc_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lccsrspspmm
!!$ subroutine psb_ccscspspmm(a,b,c,info)
!!$ use psb_c_mat_mod, only : psb_c_csc_sparse_mat
!!$ import :: psb_ipk_
!!$ implicit none
!!$ class(psb_c_csc_sparse_mat), intent(in) :: a,b
!!$ type(psb_c_csc_sparse_mat), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_ccscspspmm
end interface psb_spspmm
interface psb_symbmm
!!$ subroutine psb_csymbmm(a,b,c,info)
!!$ use psb_c_mat_mod, only : psb_cspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_cspmat_type), intent(in) :: a,b
!!$ type(psb_cspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_csymbmm
subroutine psb_lcbase_symbmm(a,b,c,info)
use psb_c_mat_mod, only : psb_lc_base_sparse_mat, psb_lc_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lc_base_sparse_mat), intent(in) :: a,b
type(psb_lc_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lcbase_symbmm
end interface psb_symbmm
interface psb_numbmm
!!$ subroutine psb_cnumbmm(a,b,c)
!!$ use psb_c_mat_mod, only : psb_cspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_cspmat_type), intent(in) :: a,b
!!$ type(psb_cspmat_type), intent(inout) :: c
!!$ end subroutine psb_cnumbmm
subroutine psb_lcbase_numbmm(a,b,c)
use psb_c_mat_mod, only : psb_lc_base_sparse_mat, psb_lc_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lc_base_sparse_mat), intent(in) :: a,b
type(psb_lc_csr_sparse_mat), intent(inout) :: c
end subroutine psb_lcbase_numbmm
end interface psb_numbmm
contains
subroutine psb_ccsprt(iout,a,iv,head,ivr,ivc)

822
base/modules/serial/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -276,6 +276,9 @@ module psb_d_base_mat_mod
procedure, pass(a) :: clone => psb_ld_base_clone
procedure, pass(a) :: make_nonunit => psb_ld_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ld_base_clean_zeros
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
!
! Convert internal indices
!
@ -296,31 +299,6 @@ module psb_d_base_mat_mod
procedure, pass(a) :: transc_1mat => psb_ld_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ld_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ld_base_vect_mv
procedure, pass(a) :: csmv => psb_ld_base_csmv
procedure, pass(a) :: csmm => psb_ld_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ld_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ld_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ld_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ld_base_vect_cssv
procedure, pass(a) :: cssv => psb_ld_base_cssv
procedure, pass(a) :: cssm => psb_ld_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ld_base_maxval
procedure, pass(a) :: spnmi => psb_ld_base_csnmi
procedure, pass(a) :: spnm1 => psb_ld_base_csnm1
procedure, pass(a) :: rowsum => psb_ld_base_rowsum
procedure, pass(a) :: arwsum => psb_ld_base_arwsum
procedure, pass(a) :: colsum => psb_ld_base_colsum
procedure, pass(a) :: aclsum => psb_ld_base_aclsum
end type psb_ld_base_sparse_mat
private :: ld_base_mat_sync, ld_base_mat_is_host, ld_base_mat_is_dev, &
@ -388,6 +366,8 @@ module psb_d_base_mat_mod
procedure, pass(a) :: set_by_cols => ld_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ld_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ld_coo_get_sort_status
procedure, pass(a) :: scals => psb_ld_coo_scals
procedure, pass(a) :: scalv => psb_ld_coo_scal
!
! This is COO specific
@ -402,22 +382,6 @@ module psb_d_base_mat_mod
procedure, pass(a) :: transp_1mat => ld_coo_transp_1mat
procedure, pass(a) :: transc_1mat => ld_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_ld_coo_csmm
procedure, pass(a) :: csmv => psb_ld_coo_csmv
procedure, pass(a) :: inner_cssm => psb_ld_coo_cssm
procedure, pass(a) :: inner_cssv => psb_ld_coo_cssv
procedure, pass(a) :: scals => psb_ld_coo_scals
procedure, pass(a) :: scalv => psb_ld_coo_scal
procedure, pass(a) :: maxval => psb_ld_coo_maxval
procedure, pass(a) :: spnmi => psb_ld_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ld_coo_csnm1
procedure, pass(a) :: rowsum => psb_ld_coo_rowsum
procedure, pass(a) :: arwsum => psb_ld_coo_arwsum
procedure, pass(a) :: colsum => psb_ld_coo_colsum
procedure, pass(a) :: aclsum => psb_ld_coo_aclsum
end type psb_ld_coo_sparse_mat
@ -2756,6 +2720,43 @@ module psb_d_base_mat_mod
end subroutine psb_ld_base_clean_zeros
end interface
!
!> Function base_scals:
!! \memberof psb_ld_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ld_base_scals(d,a,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_ld_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_ld_base_scal(d,a,info,side)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ld_base_scal
end interface
!
!> Function transp:
!! \memberof psb_ld_base_sparse_mat
@ -2816,554 +2817,119 @@ module psb_d_base_mat_mod
end subroutine psb_ld_base_transc_1mat
end interface
! == ===============
!
!> Function csmm:
!! \memberof psb_ld_base_sparse_mat
!! \brief Product by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
! COO interfaces
!
interface
subroutine psb_ld_base_csmm(alpha,a,x,beta,y,info,trans)
! == ===============
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_ld_coo_reallocate_nz(nz,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_csmm
integer(psb_lpk_), intent(in) :: nz
class(psb_ld_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ld_coo_reallocate_nz
end interface
!> Function csmv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Product by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_ld_base_csmv(alpha,a,x,beta,y,info,trans)
subroutine psb_ld_coo_reinit(a,clear)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_csmv
class(psb_ld_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ld_coo_reinit
end interface
!> Function vect_mv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Product by an encapsulated array type(psb_ld_vect_type)
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!! Usually the unwrapping of the encapsulated vector is done
!! here, so that all the derived classes need only the
!! versions with the standard arrays.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input X
!! \param beta Scaling factor for y
!! \param y the input/output Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_ld_base_vect_mv(alpha,a,x,beta,y,info,trans)
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_ld_coo_trim(a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y
class(psb_ld_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ld_coo_trim
end interface
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros
!
interface
subroutine psb_ld_coo_clean_zeros(a,info)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_vect_mv
end subroutine psb_ld_coo_clean_zeros
end interface
!
!> Function cssm:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssm.
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_ld_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ld_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ld_coo_allocate_mnnz
end interface
!> \memberof psb_ld_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ld_base_inner_cssm(alpha,a,x,beta,y,info,trans)
subroutine psb_ld_coo_mold(a,b,info)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_inner_cssm
class(psb_ld_coo_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_coo_mold
end interface
!
!> Function cssv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssv.
!> Function print.
!! \memberof psb_ld_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_ld_base_inner_cssv(alpha,a,x,beta,y,info,trans)
interface
subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_inner_cssv
integer(psb_ipk_), intent(in) :: iout
class(psb_ld_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ld_coo_print
end interface
!
!> Function inner_vect_cssv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_ld_vect_type)
!> Function get_nz_row.
!! \memberof psb_ld_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by vect_cssv.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!
interface
subroutine psb_ld_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_base_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_base_inner_vect_sv
end interface
!
!> Function cssm:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ld_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_ld_base_cssm
end interface
!
!> Function cssv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ld_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_ld_base_cssv
end interface
!
!> Function vect_cssv:
!! \memberof psb_ld_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_ld_vect_type)
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ld_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
class(psb_d_base_vect_type), intent(inout) :: x,y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
class(psb_d_base_vect_type), optional, intent(inout) :: d
end subroutine psb_ld_base_vect_cssv
end interface
!
!> Function base_scals:
!! \memberof psb_ld_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ld_base_scals(d,a,info)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_ld_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_ld_base_scal(d,a,info,side)
import
class(psb_ld_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ld_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_ld_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_ld_base_maxval(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ld_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_ld_base_csnmi(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ld_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_ld_base_csnm1(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_ld_base_rowsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_ld_base_arwsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_ld_base_colsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_ld_base_aclsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_aclsum
end interface
! == ===============
!
! COO interfaces
!
! == ===============
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_ld_coo_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ld_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ld_coo_reallocate_nz
end interface
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_ld_coo_reinit(a,clear)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ld_coo_reinit
end interface
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_ld_coo_trim(a)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ld_coo_trim
end interface
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_clean_zeros
!
interface
subroutine psb_ld_coo_clean_zeros(a,info)
import
class(psb_ld_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_coo_clean_zeros
end interface
!
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_ld_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ld_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ld_coo_allocate_mnnz
end interface
!> \memberof psb_ld_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ld_coo_mold(a,b,info)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_coo_mold
end interface
!
!> Function print.
!! \memberof psb_ld_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_ld_coo_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ld_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ld_coo_print
end interface
!
!> Function get_nz_row.
!! \memberof psb_ld_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! \param idx The row to search.
!! \param idx The row to search.
!!
!
interface
@ -3627,138 +3193,6 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_csgetrow
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssv
interface
subroutine psb_ld_coo_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_coo_cssv
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cssm
interface
subroutine psb_ld_coo_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_coo_cssm
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmv
interface
subroutine psb_ld_coo_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
real(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_coo_csmv
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csmm
interface
subroutine psb_ld_coo_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
real(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ld_coo_csmm
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_coo_maxval(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_maxval
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csnmi
interface
function psb_ld_coo_csnmi(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_csnmi
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csnm1
interface
function psb_ld_coo_csnm1(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_csnm1
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_coo_rowsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_rowsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_coo_arwsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_arwsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_coo_colsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_colsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_coo_aclsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_aclsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_get_diag
@ -3771,6 +3205,7 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_get_diag
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scal
@ -3796,7 +3231,6 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_scals
end interface
contains
@ -3818,7 +3252,7 @@ contains
implicit none
class(psb_d_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_ip
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%ia)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -4042,7 +3476,7 @@ contains
implicit none
class(psb_ld_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_lp
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%ia)
res = res + psb_sizeof_lp * psb_size(a%ja)

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

@ -495,6 +495,334 @@ module psb_d_csr_mat_mod
end interface
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
!!
!! psb_ld_csr_sparse_mat type and the related methods.
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_ld_base_sparse_mat) :: psb_ld_csr_sparse_mat
!> Pointers to beginning of rows in JA and VAL.
integer(psb_lpk_), allocatable :: irp(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_rows => ld_csr_is_by_rows
procedure, pass(a) :: get_size => ld_csr_get_size
procedure, pass(a) :: get_nzeros => ld_csr_get_nzeros
procedure, nopass :: get_fmt => ld_csr_get_fmt
procedure, pass(a) :: sizeof => ld_csr_sizeof
procedure, pass(a) :: reallocate_nz => psb_ld_csr_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => psb_ld_cp_csr_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ld_cp_csr_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ld_cp_csr_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ld_mv_csr_to_coo
procedure, pass(a) :: mv_from_coo => psb_ld_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ld_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_csr_from_fmt
procedure, pass(a) :: csput_a => psb_ld_csr_csput_a
procedure, pass(a) :: get_diag => psb_ld_csr_get_diag
procedure, pass(a) :: csgetptn => psb_ld_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_ld_csr_csgetrow
procedure, pass(a) :: get_nz_row => ld_csr_get_nz_row
procedure, pass(a) :: reinit => psb_ld_csr_reinit
procedure, pass(a) :: trim => psb_ld_csr_trim
procedure, pass(a) :: print => psb_ld_csr_print
procedure, pass(a) :: free => ld_csr_free
procedure, pass(a) :: mold => psb_ld_csr_mold
procedure, pass(a) :: scals => psb_ld_csr_scals
procedure, pass(a) :: scalv => psb_ld_csr_scal
end type psb_ld_csr_sparse_mat
private :: ld_csr_get_nzeros, ld_csr_free, ld_csr_get_fmt, &
& ld_csr_get_size, ld_csr_sizeof, ld_csr_get_nz_row, &
& ld_csr_is_by_rows
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_ld_csr_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ld_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csr_reallocate_nz
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_ld_csr_reinit(a,clear)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ld_csr_reinit
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_ld_csr_trim(a)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ld_csr_trim
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ld_csr_mold(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_mold
end interface
!> \memberof psb_ld_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_ld_csr_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ld_csr_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ld_csr_allocate_mnnz
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_print
interface
subroutine psb_ld_csr_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ld_csr_print
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_coo
interface
subroutine psb_ld_cp_csr_to_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_to_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_coo
interface
subroutine psb_ld_cp_csr_from_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_from_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_to_fmt
interface
subroutine psb_ld_cp_csr_to_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_to_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from_fmt
interface
subroutine psb_ld_cp_csr_from_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_cp_csr_from_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_coo
interface
subroutine psb_ld_mv_csr_to_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_to_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_coo
interface
subroutine psb_ld_mv_csr_from_coo(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_from_coo
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_to_fmt
interface
subroutine psb_ld_mv_csr_to_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_to_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from_fmt
interface
subroutine psb_ld_mv_csr_from_fmt(a,b,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
class(psb_ld_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_mv_csr_from_fmt
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_cp_from
interface
subroutine psb_ld_csr_cp_from(a,b)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
type(psb_ld_csr_sparse_mat), intent(in) :: b
end subroutine psb_ld_csr_cp_from
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_mv_from
interface
subroutine psb_ld_csr_mv_from(a,b)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
type(psb_ld_csr_sparse_mat), intent(inout) :: b
end subroutine psb_ld_csr_mv_from
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csput_a
interface
subroutine psb_ld_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_ld_csr_csput_a
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_ld_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetptn
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetrow
interface
subroutine psb_ld_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetrow
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_csgetblk
interface
subroutine psb_ld_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
class(psb_ld_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ld_csr_csgetblk
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_get_diag
interface
subroutine psb_ld_csr_get_diag(a,d,info)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_get_diag
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scal
interface
subroutine psb_ld_csr_scal(d,a,info,side)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ld_csr_scal
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scals
interface
subroutine psb_ld_csr_scals(d,a,info)
import
class(psb_ld_csr_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_scals
end interface
contains
@ -525,7 +853,7 @@ contains
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = 2 * psb_sizeof_ip
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%irp)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -614,4 +942,120 @@ contains
end subroutine d_csr_free
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function ld_csr_is_by_rows(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function ld_csr_is_by_rows
function ld_csr_sizeof(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 2 * psb_sizeof_lp
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function ld_csr_sizeof
function ld_csr_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSR'
end function ld_csr_get_fmt
function ld_csr_get_nzeros(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%irp(a%get_nrows()+1)-1
end function ld_csr_get_nzeros
function ld_csr_get_size(a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ja)) then
res = size(a%ja)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function ld_csr_get_size
function ld_csr_get_nz_row(idx,a) result(res)
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function ld_csr_get_nz_row
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine ld_csr_free(a)
implicit none
class(psb_ld_csr_sparse_mat), intent(inout) :: a
if (allocated(a%irp)) deallocate(a%irp)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine ld_csr_free
end module psb_d_csr_mat_mod

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

@ -72,8 +72,8 @@
module psb_d_mat_mod
use psb_d_base_mat_mod
use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat
use psb_d_csc_mat_mod, only : psb_d_csc_sparse_mat
use psb_d_csr_mat_mod, only : psb_d_csr_sparse_mat, psb_ld_csr_sparse_mat
use psb_d_csc_mat_mod, only : psb_d_csc_sparse_mat
type :: psb_dspmat_type

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

@ -203,6 +203,69 @@ module psb_d_serial_mod
end subroutine psb_d_aspxpby
end interface psb_aspxpby
interface psb_spspmm
!!$ subroutine psb_dspspmm(a,b,c,info)
!!$ use psb_d_mat_mod, only : psb_dspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_dspmat_type), intent(in) :: a,b
!!$ type(psb_dspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_dspspmm
subroutine psb_ldcsrspspmm(a,b,c,info)
use psb_d_mat_mod, only : psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldcsrspspmm
!!$ subroutine psb_dcscspspmm(a,b,c,info)
!!$ use psb_d_mat_mod, only : psb_d_csc_sparse_mat
!!$ import :: psb_ipk_
!!$ implicit none
!!$ class(psb_d_csc_sparse_mat), intent(in) :: a,b
!!$ type(psb_d_csc_sparse_mat), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_dcscspspmm
end interface psb_spspmm
interface psb_symbmm
!!$ subroutine psb_dsymbmm(a,b,c,info)
!!$ use psb_d_mat_mod, only : psb_dspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_dspmat_type), intent(in) :: a,b
!!$ type(psb_dspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_dsymbmm
subroutine psb_ldbase_symbmm(a,b,c,info)
use psb_d_mat_mod, only : psb_ld_base_sparse_mat, psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ldbase_symbmm
end interface psb_symbmm
interface psb_numbmm
!!$ subroutine psb_dnumbmm(a,b,c)
!!$ use psb_d_mat_mod, only : psb_dspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_dspmat_type), intent(in) :: a,b
!!$ type(psb_dspmat_type), intent(inout) :: c
!!$ end subroutine psb_dnumbmm
subroutine psb_ldbase_numbmm(a,b,c)
use psb_d_mat_mod, only : psb_ld_base_sparse_mat, psb_ld_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a,b
type(psb_ld_csr_sparse_mat), intent(inout) :: c
end subroutine psb_ldbase_numbmm
end interface psb_numbmm
contains
subroutine psb_dcsprt(iout,a,iv,head,ivr,ivc)

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

@ -43,7 +43,7 @@
!
module psb_ld_csr_mat_mod
use psb_ld_base_mat_mod
use psb_d_base_mat_mod
!> \namespace psb_base_mod \class psb_ld_csr_sparse_mat
!! \extends psb_ld_base_mat_mod::psb_ld_base_sparse_mat
@ -525,10 +525,10 @@ contains
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = 2 * psb_sizeof_lp
res = res + psb_sizeof_dp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%irp)
res = res + psb_sizeof_ip * psb_size(a%ja)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function ld_csr_sizeof

822
base/modules/serial/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -276,6 +276,9 @@ module psb_s_base_mat_mod
procedure, pass(a) :: clone => psb_ls_base_clone
procedure, pass(a) :: make_nonunit => psb_ls_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ls_base_clean_zeros
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
!
! Convert internal indices
!
@ -296,31 +299,6 @@ module psb_s_base_mat_mod
procedure, pass(a) :: transc_1mat => psb_ls_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_ls_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_ls_base_vect_mv
procedure, pass(a) :: csmv => psb_ls_base_csmv
procedure, pass(a) :: csmm => psb_ls_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_ls_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_ls_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_ls_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_ls_base_vect_cssv
procedure, pass(a) :: cssv => psb_ls_base_cssv
procedure, pass(a) :: cssm => psb_ls_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ls_base_maxval
procedure, pass(a) :: spnmi => psb_ls_base_csnmi
procedure, pass(a) :: spnm1 => psb_ls_base_csnm1
procedure, pass(a) :: rowsum => psb_ls_base_rowsum
procedure, pass(a) :: arwsum => psb_ls_base_arwsum
procedure, pass(a) :: colsum => psb_ls_base_colsum
procedure, pass(a) :: aclsum => psb_ls_base_aclsum
end type psb_ls_base_sparse_mat
private :: ls_base_mat_sync, ls_base_mat_is_host, ls_base_mat_is_dev, &
@ -388,6 +366,8 @@ module psb_s_base_mat_mod
procedure, pass(a) :: set_by_cols => ls_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ls_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ls_coo_get_sort_status
procedure, pass(a) :: scals => psb_ls_coo_scals
procedure, pass(a) :: scalv => psb_ls_coo_scal
!
! This is COO specific
@ -402,22 +382,6 @@ module psb_s_base_mat_mod
procedure, pass(a) :: transp_1mat => ls_coo_transp_1mat
procedure, pass(a) :: transc_1mat => ls_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_ls_coo_csmm
procedure, pass(a) :: csmv => psb_ls_coo_csmv
procedure, pass(a) :: inner_cssm => psb_ls_coo_cssm
procedure, pass(a) :: inner_cssv => psb_ls_coo_cssv
procedure, pass(a) :: scals => psb_ls_coo_scals
procedure, pass(a) :: scalv => psb_ls_coo_scal
procedure, pass(a) :: maxval => psb_ls_coo_maxval
procedure, pass(a) :: spnmi => psb_ls_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ls_coo_csnm1
procedure, pass(a) :: rowsum => psb_ls_coo_rowsum
procedure, pass(a) :: arwsum => psb_ls_coo_arwsum
procedure, pass(a) :: colsum => psb_ls_coo_colsum
procedure, pass(a) :: aclsum => psb_ls_coo_aclsum
end type psb_ls_coo_sparse_mat
@ -2756,6 +2720,43 @@ module psb_s_base_mat_mod
end subroutine psb_ls_base_clean_zeros
end interface
!
!> Function base_scals:
!! \memberof psb_ls_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ls_base_scals(d,a,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_ls_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_ls_base_scal(d,a,info,side)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ls_base_scal
end interface
!
!> Function transp:
!! \memberof psb_ls_base_sparse_mat
@ -2816,554 +2817,119 @@ module psb_s_base_mat_mod
end subroutine psb_ls_base_transc_1mat
end interface
! == ===============
!
!> Function csmm:
!! \memberof psb_ls_base_sparse_mat
!! \brief Product by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
! COO interfaces
!
interface
subroutine psb_ls_base_csmm(alpha,a,x,beta,y,info,trans)
! == ===============
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_ls_coo_reallocate_nz(nz,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_csmm
integer(psb_lpk_), intent(in) :: nz
class(psb_ls_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ls_coo_reallocate_nz
end interface
!> Function csmv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Product by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_ls_base_csmv(alpha,a,x,beta,y,info,trans)
subroutine psb_ls_coo_reinit(a,clear)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_csmv
class(psb_ls_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ls_coo_reinit
end interface
!> Function vect_mv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Product by an encapsulated array type(psb_ls_vect_type)
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!! Usually the unwrapping of the encapsulated vector is done
!! here, so that all the derived classes need only the
!! versions with the standard arrays.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input X
!! \param beta Scaling factor for y
!! \param y the input/output Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_ls_base_vect_mv(alpha,a,x,beta,y,info,trans)
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_ls_coo_trim(a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y
class(psb_ls_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ls_coo_trim
end interface
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros
!
interface
subroutine psb_ls_coo_clean_zeros(a,info)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_vect_mv
end subroutine psb_ls_coo_clean_zeros
end interface
!
!> Function cssm:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssm.
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_ls_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ls_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ls_coo_allocate_mnnz
end interface
!> \memberof psb_ls_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ls_base_inner_cssm(alpha,a,x,beta,y,info,trans)
subroutine psb_ls_coo_mold(a,b,info)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_inner_cssm
class(psb_ls_coo_sparse_mat), intent(in) :: a
class(psb_ls_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_coo_mold
end interface
!
!> Function cssv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssv.
!> Function print.
!! \memberof psb_ls_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_ls_base_inner_cssv(alpha,a,x,beta,y,info,trans)
interface
subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_inner_cssv
integer(psb_ipk_), intent(in) :: iout
class(psb_ls_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ls_coo_print
end interface
!
!> Function inner_vect_cssv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_ls_vect_type)
!> Function get_nz_row.
!! \memberof psb_ls_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by vect_cssv.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!
interface
subroutine psb_ls_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_base_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_base_inner_vect_sv
end interface
!
!> Function cssm:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ls_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_spk_), intent(in), optional :: d(:)
end subroutine psb_ls_base_cssm
end interface
!
!> Function cssv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ls_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
real(psb_spk_), intent(in), optional :: d(:)
end subroutine psb_ls_base_cssv
end interface
!
!> Function vect_cssv:
!! \memberof psb_ls_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_ls_vect_type)
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D [none] Diagonal for scaling.
!!
!
interface
subroutine psb_ls_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta
class(psb_s_base_vect_type), intent(inout) :: x,y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
class(psb_s_base_vect_type), optional, intent(inout) :: d
end subroutine psb_ls_base_vect_cssv
end interface
!
!> Function base_scals:
!! \memberof psb_ls_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_ls_base_scals(d,a,info)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_ls_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_ls_base_scal(d,a,info,side)
import
class(psb_ls_base_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ls_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_ls_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_ls_base_maxval(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ls_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_ls_base_csnmi(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ls_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_ls_base_csnm1(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_ls_base_rowsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_ls_base_arwsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_ls_base_colsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_ls_base_aclsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_aclsum
end interface
! == ===============
!
! COO interfaces
!
! == ===============
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_ls_coo_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ls_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ls_coo_reallocate_nz
end interface
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_ls_coo_reinit(a,clear)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ls_coo_reinit
end interface
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_ls_coo_trim(a)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
end subroutine psb_ls_coo_trim
end interface
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_clean_zeros
!
interface
subroutine psb_ls_coo_clean_zeros(a,info)
import
class(psb_ls_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_coo_clean_zeros
end interface
!
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_ls_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ls_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ls_coo_allocate_mnnz
end interface
!> \memberof psb_ls_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ls_coo_mold(a,b,info)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
class(psb_ls_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_coo_mold
end interface
!
!> Function print.
!! \memberof psb_ls_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_ls_coo_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ls_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ls_coo_print
end interface
!
!> Function get_nz_row.
!! \memberof psb_ls_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! \param idx The row to search.
!! \param idx The row to search.
!!
!
interface
@ -3627,138 +3193,6 @@ module psb_s_base_mat_mod
end subroutine psb_ls_coo_csgetrow
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cssv
interface
subroutine psb_ls_coo_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_coo_cssv
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cssm
interface
subroutine psb_ls_coo_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_coo_cssm
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csmv
interface
subroutine psb_ls_coo_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:)
real(psb_spk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_coo_csmv
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csmm
interface
subroutine psb_ls_coo_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(in) :: alpha, beta, x(:,:)
real(psb_spk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_ls_coo_csmm
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_maxval
interface
function psb_ls_coo_maxval(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_maxval
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csnmi
interface
function psb_ls_coo_csnmi(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_csnmi
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csnm1
interface
function psb_ls_coo_csnm1(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_csnm1
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_rowsum
interface
subroutine psb_ls_coo_rowsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_rowsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_arwsum
interface
subroutine psb_ls_coo_arwsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_arwsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_colsum
interface
subroutine psb_ls_coo_colsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_colsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_aclsum
interface
subroutine psb_ls_coo_aclsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_aclsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_get_diag
@ -3771,6 +3205,7 @@ module psb_s_base_mat_mod
end subroutine psb_ls_coo_get_diag
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scal
@ -3796,7 +3231,6 @@ module psb_s_base_mat_mod
end subroutine psb_ls_coo_scals
end interface
contains
@ -3818,7 +3252,7 @@ contains
implicit none
class(psb_s_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_ip
res = res + psb_sizeof_sp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%ia)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -4042,7 +3476,7 @@ contains
implicit none
class(psb_ls_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_lp
res = res + psb_sizeof_sp * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%ia)
res = res + psb_sizeof_lp * psb_size(a%ja)

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

@ -495,6 +495,334 @@ module psb_s_csr_mat_mod
end interface
!> \namespace psb_base_mod \class psb_ls_csr_sparse_mat
!! \extends psb_ls_base_mat_mod::psb_ls_base_sparse_mat
!!
!! psb_ls_csr_sparse_mat type and the related methods.
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_ls_base_sparse_mat) :: psb_ls_csr_sparse_mat
!> Pointers to beginning of rows in JA and VAL.
integer(psb_lpk_), allocatable :: irp(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
real(psb_spk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_rows => ls_csr_is_by_rows
procedure, pass(a) :: get_size => ls_csr_get_size
procedure, pass(a) :: get_nzeros => ls_csr_get_nzeros
procedure, nopass :: get_fmt => ls_csr_get_fmt
procedure, pass(a) :: sizeof => ls_csr_sizeof
procedure, pass(a) :: reallocate_nz => psb_ls_csr_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ls_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ls_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => psb_ls_cp_csr_from_coo
procedure, pass(a) :: cp_to_fmt => psb_ls_cp_csr_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_ls_cp_csr_from_fmt
procedure, pass(a) :: mv_to_coo => psb_ls_mv_csr_to_coo
procedure, pass(a) :: mv_from_coo => psb_ls_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_ls_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_csr_from_fmt
procedure, pass(a) :: csput_a => psb_ls_csr_csput_a
procedure, pass(a) :: get_diag => psb_ls_csr_get_diag
procedure, pass(a) :: csgetptn => psb_ls_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_ls_csr_csgetrow
procedure, pass(a) :: get_nz_row => ls_csr_get_nz_row
procedure, pass(a) :: reinit => psb_ls_csr_reinit
procedure, pass(a) :: trim => psb_ls_csr_trim
procedure, pass(a) :: print => psb_ls_csr_print
procedure, pass(a) :: free => ls_csr_free
procedure, pass(a) :: mold => psb_ls_csr_mold
procedure, pass(a) :: scals => psb_ls_csr_scals
procedure, pass(a) :: scalv => psb_ls_csr_scal
end type psb_ls_csr_sparse_mat
private :: ls_csr_get_nzeros, ls_csr_free, ls_csr_get_fmt, &
& ls_csr_get_size, ls_csr_sizeof, ls_csr_get_nz_row, &
& ls_csr_is_by_rows
!> \memberof psb_ls_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_ls_csr_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_ls_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ls_csr_reallocate_nz
end interface
!> \memberof psb_ls_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_ls_csr_reinit(a,clear)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_ls_csr_reinit
end interface
!> \memberof psb_ls_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_ls_csr_trim(a)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
end subroutine psb_ls_csr_trim
end interface
!> \memberof psb_ls_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_ls_csr_mold(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csr_mold
end interface
!> \memberof psb_ls_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_ls_csr_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_ls_csr_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_ls_csr_allocate_mnnz
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_print
interface
subroutine psb_ls_csr_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_ls_csr_print
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_to_coo
interface
subroutine psb_ls_cp_csr_to_coo(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_csr_to_coo
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from_coo
interface
subroutine psb_ls_cp_csr_from_coo(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_csr_from_coo
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_to_fmt
interface
subroutine psb_ls_cp_csr_to_fmt(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_csr_to_fmt
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from_fmt
interface
subroutine psb_ls_cp_csr_from_fmt(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_cp_csr_from_fmt
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_mv_to_coo
interface
subroutine psb_ls_mv_csr_to_coo(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_mv_csr_to_coo
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_mv_from_coo
interface
subroutine psb_ls_mv_csr_from_coo(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_mv_csr_from_coo
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_mv_to_fmt
interface
subroutine psb_ls_mv_csr_to_fmt(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_mv_csr_to_fmt
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_mv_from_fmt
interface
subroutine psb_ls_mv_csr_from_fmt(a,b,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
class(psb_ls_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_mv_csr_from_fmt
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_cp_from
interface
subroutine psb_ls_csr_cp_from(a,b)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
type(psb_ls_csr_sparse_mat), intent(in) :: b
end subroutine psb_ls_csr_cp_from
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_mv_from
interface
subroutine psb_ls_csr_mv_from(a,b)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
type(psb_ls_csr_sparse_mat), intent(inout) :: b
end subroutine psb_ls_csr_mv_from
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csput_a
interface
subroutine psb_ls_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_ls_csr_csput_a
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_ls_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csr_csgetptn
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csgetrow
interface
subroutine psb_ls_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
real(psb_spk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csr_csgetrow
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_csgetblk
interface
subroutine psb_ls_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_ls_csr_csgetblk
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_get_diag
interface
subroutine psb_ls_csr_get_diag(a,d,info)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csr_get_diag
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scal
interface
subroutine psb_ls_csr_scal(d,a,info,side)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_ls_csr_scal
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scals
interface
subroutine psb_ls_csr_scals(d,a,info)
import
class(psb_ls_csr_sparse_mat), intent(inout) :: a
real(psb_spk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csr_scals
end interface
contains
@ -525,7 +853,7 @@ contains
implicit none
class(psb_s_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = 2 * psb_sizeof_ip
res = res + psb_sizeof_sp * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%irp)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -614,4 +942,120 @@ contains
end subroutine s_csr_free
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function ls_csr_is_by_rows(a) result(res)
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function ls_csr_is_by_rows
function ls_csr_sizeof(a) result(res)
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 2 * psb_sizeof_lp
res = res + psb_sizeof_sp * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function ls_csr_sizeof
function ls_csr_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSR'
end function ls_csr_get_fmt
function ls_csr_get_nzeros(a) result(res)
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%irp(a%get_nrows()+1)-1
end function ls_csr_get_nzeros
function ls_csr_get_size(a) result(res)
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ja)) then
res = size(a%ja)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function ls_csr_get_size
function ls_csr_get_nz_row(idx,a) result(res)
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function ls_csr_get_nz_row
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine ls_csr_free(a)
implicit none
class(psb_ls_csr_sparse_mat), intent(inout) :: a
if (allocated(a%irp)) deallocate(a%irp)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine ls_csr_free
end module psb_s_csr_mat_mod

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

@ -72,8 +72,8 @@
module psb_s_mat_mod
use psb_s_base_mat_mod
use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat
use psb_s_csc_mat_mod, only : psb_s_csc_sparse_mat
use psb_s_csr_mat_mod, only : psb_s_csr_sparse_mat, psb_ls_csr_sparse_mat
use psb_s_csc_mat_mod, only : psb_s_csc_sparse_mat
type :: psb_sspmat_type

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

@ -203,6 +203,69 @@ module psb_s_serial_mod
end subroutine psb_s_aspxpby
end interface psb_aspxpby
interface psb_spspmm
!!$ subroutine psb_sspspmm(a,b,c,info)
!!$ use psb_s_mat_mod, only : psb_sspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_sspmat_type), intent(in) :: a,b
!!$ type(psb_sspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_sspspmm
subroutine psb_lscsrspspmm(a,b,c,info)
use psb_s_mat_mod, only : psb_ls_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a,b
type(psb_ls_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lscsrspspmm
!!$ subroutine psb_scscspspmm(a,b,c,info)
!!$ use psb_s_mat_mod, only : psb_s_csc_sparse_mat
!!$ import :: psb_ipk_
!!$ implicit none
!!$ class(psb_s_csc_sparse_mat), intent(in) :: a,b
!!$ type(psb_s_csc_sparse_mat), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_scscspspmm
end interface psb_spspmm
interface psb_symbmm
!!$ subroutine psb_ssymbmm(a,b,c,info)
!!$ use psb_s_mat_mod, only : psb_sspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_sspmat_type), intent(in) :: a,b
!!$ type(psb_sspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_ssymbmm
subroutine psb_lsbase_symbmm(a,b,c,info)
use psb_s_mat_mod, only : psb_ls_base_sparse_mat, psb_ls_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ls_base_sparse_mat), intent(in) :: a,b
type(psb_ls_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lsbase_symbmm
end interface psb_symbmm
interface psb_numbmm
!!$ subroutine psb_snumbmm(a,b,c)
!!$ use psb_s_mat_mod, only : psb_sspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_sspmat_type), intent(in) :: a,b
!!$ type(psb_sspmat_type), intent(inout) :: c
!!$ end subroutine psb_snumbmm
subroutine psb_lsbase_numbmm(a,b,c)
use psb_s_mat_mod, only : psb_ls_base_sparse_mat, psb_ls_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_ls_base_sparse_mat), intent(in) :: a,b
type(psb_ls_csr_sparse_mat), intent(inout) :: c
end subroutine psb_lsbase_numbmm
end interface psb_numbmm
contains
subroutine psb_scsprt(iout,a,iv,head,ivr,ivc)

822
base/modules/serial/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -276,6 +276,9 @@ module psb_z_base_mat_mod
procedure, pass(a) :: clone => psb_lz_base_clone
procedure, pass(a) :: make_nonunit => psb_lz_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lz_base_clean_zeros
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
!
! Convert internal indices
!
@ -296,31 +299,6 @@ module psb_z_base_mat_mod
procedure, pass(a) :: transc_1mat => psb_lz_base_transc_1mat
procedure, pass(a) :: transc_2mat => psb_lz_base_transc_2mat
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: vect_mv => psb_lz_base_vect_mv
procedure, pass(a) :: csmv => psb_lz_base_csmv
procedure, pass(a) :: csmm => psb_lz_base_csmm
generic, public :: spmm => csmm, csmv, vect_mv
procedure, pass(a) :: in_vect_sv => psb_lz_base_inner_vect_sv
procedure, pass(a) :: inner_cssv => psb_lz_base_inner_cssv
procedure, pass(a) :: inner_cssm => psb_lz_base_inner_cssm
generic, public :: inner_spsm => inner_cssm, inner_cssv, in_vect_sv
procedure, pass(a) :: vect_cssv => psb_lz_base_vect_cssv
procedure, pass(a) :: cssv => psb_lz_base_cssv
procedure, pass(a) :: cssm => psb_lz_base_cssm
generic, public :: spsm => cssm, cssv, vect_cssv
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lz_base_maxval
procedure, pass(a) :: spnmi => psb_lz_base_csnmi
procedure, pass(a) :: spnm1 => psb_lz_base_csnm1
procedure, pass(a) :: rowsum => psb_lz_base_rowsum
procedure, pass(a) :: arwsum => psb_lz_base_arwsum
procedure, pass(a) :: colsum => psb_lz_base_colsum
procedure, pass(a) :: aclsum => psb_lz_base_aclsum
end type psb_lz_base_sparse_mat
private :: lz_base_mat_sync, lz_base_mat_is_host, lz_base_mat_is_dev, &
@ -388,6 +366,8 @@ module psb_z_base_mat_mod
procedure, pass(a) :: set_by_cols => lz_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lz_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lz_coo_get_sort_status
procedure, pass(a) :: scals => psb_lz_coo_scals
procedure, pass(a) :: scalv => psb_lz_coo_scal
!
! This is COO specific
@ -402,22 +382,6 @@ module psb_z_base_mat_mod
procedure, pass(a) :: transp_1mat => lz_coo_transp_1mat
procedure, pass(a) :: transc_1mat => lz_coo_transc_1mat
!
! Computational methods.
!
procedure, pass(a) :: csmm => psb_lz_coo_csmm
procedure, pass(a) :: csmv => psb_lz_coo_csmv
procedure, pass(a) :: inner_cssm => psb_lz_coo_cssm
procedure, pass(a) :: inner_cssv => psb_lz_coo_cssv
procedure, pass(a) :: scals => psb_lz_coo_scals
procedure, pass(a) :: scalv => psb_lz_coo_scal
procedure, pass(a) :: maxval => psb_lz_coo_maxval
procedure, pass(a) :: spnmi => psb_lz_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lz_coo_csnm1
procedure, pass(a) :: rowsum => psb_lz_coo_rowsum
procedure, pass(a) :: arwsum => psb_lz_coo_arwsum
procedure, pass(a) :: colsum => psb_lz_coo_colsum
procedure, pass(a) :: aclsum => psb_lz_coo_aclsum
end type psb_lz_coo_sparse_mat
@ -2756,6 +2720,43 @@ module psb_z_base_mat_mod
end subroutine psb_lz_base_clean_zeros
end interface
!
!> Function base_scals:
!! \memberof psb_lz_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lz_base_scals(d,a,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_lz_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_lz_base_scal(d,a,info,side)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lz_base_scal
end interface
!
!> Function transp:
!! \memberof psb_lz_base_sparse_mat
@ -2816,554 +2817,119 @@ module psb_z_base_mat_mod
end subroutine psb_lz_base_transc_1mat
end interface
! == ===============
!
!> Function csmm:
!! \memberof psb_lz_base_sparse_mat
!! \brief Product by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
! COO interfaces
!
interface
subroutine psb_lz_base_csmm(alpha,a,x,beta,y,info,trans)
! == ===============
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_lz_coo_reallocate_nz(nz,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_csmm
integer(psb_lpk_), intent(in) :: nz
class(psb_lz_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lz_coo_reallocate_nz
end interface
!> Function csmv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Product by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_lz_base_csmv(alpha,a,x,beta,y,info,trans)
subroutine psb_lz_coo_reinit(a,clear)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_csmv
class(psb_lz_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lz_coo_reinit
end interface
!> Function vect_mv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Product by an encapsulated array type(psb_lz_vect_type)
!!
!! Compute
!! Y = alpha*op(A)*X + beta*Y
!! Usually the unwrapping of the encapsulated vector is done
!! here, so that all the derived classes need only the
!! versions with the standard arrays.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input X
!! \param beta Scaling factor for y
!! \param y the input/output Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!
interface
subroutine psb_lz_base_vect_mv(alpha,a,x,beta,y,info,trans)
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_lz_coo_trim(a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y
class(psb_lz_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lz_coo_trim
end interface
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros
!
interface
subroutine psb_lz_coo_clean_zeros(a,info)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_vect_mv
end subroutine psb_lz_coo_clean_zeros
end interface
!
!> Function cssm:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssm.
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_lz_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lz_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lz_coo_allocate_mnnz
end interface
!> \memberof psb_lz_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lz_base_inner_cssm(alpha,a,x,beta,y,info,trans)
subroutine psb_lz_coo_mold(a,b,info)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_inner_cssm
class(psb_lz_coo_sparse_mat), intent(in) :: a
class(psb_lz_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_coo_mold
end interface
!
!> Function cssv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by cssv.
!> Function print.
!! \memberof psb_lz_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_lz_base_inner_cssv(alpha,a,x,beta,y,info,trans)
interface
subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_inner_cssv
integer(psb_ipk_), intent(in) :: iout
class(psb_lz_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lz_coo_print
end interface
!
!> Function inner_vect_cssv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_lz_vect_type)
!> Function get_nz_row.
!! \memberof psb_lz_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! Internal workhorse called by vect_cssv.
!! Must be overridden explicitly in case of non standard memory
!! management; an example would be external memory allocation
!! in attached processors such as GPUs.
!!
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!
interface
subroutine psb_lz_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x, y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_base_inner_vect_sv
end interface
!
!> Function cssm:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by a dense rank 2 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:,:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:,:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lz_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_lz_base_cssm
end interface
!
!> Function cssv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by a dense rank 1 array.
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x(:) the input dense X
!! \param beta Scaling factor for y
!! \param y(:) the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D(:) [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lz_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
complex(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_lz_base_cssv
end interface
!
!> Function vect_cssv:
!! \memberof psb_lz_base_sparse_mat
!! \brief Triangular system solve by
!! an encapsulated array type(psb_lz_vect_type)
!!
!! Compute
!! Y = alpha*op(A^-1)*X + beta*Y
!!
!! \param alpha Scaling factor for Ax
!! \param A the input sparse matrix
!! \param x the input dense X
!! \param beta Scaling factor for y
!! \param y the input/output dense Y
!! \param info return code
!! \param trans [N] Whether to use A (N), its transpose (T)
!! or its conjugate transpose (C)
!! \param scale [N] Apply a scaling on Right (R) i.e. ADX
!! or on the Left (L) i.e. DAx
!! \param D [none] Diagonal for scaling.
!!
!
interface
subroutine psb_lz_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta
class(psb_z_base_vect_type), intent(inout) :: x,y
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans, scale
class(psb_z_base_vect_type), optional, intent(inout) :: d
end subroutine psb_lz_base_vect_cssv
end interface
!
!> Function base_scals:
!! \memberof psb_lz_base_sparse_mat
!! \brief Scale a matrix by a single scalar value
!!
!! \param d Scaling factor
!! \param info return code
!
interface
subroutine psb_lz_base_scals(d,a,info)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_scals
end interface
!
!> Function base_scal:
!! \memberof psb_lz_base_sparse_mat
!! \brief Scale a matrix by a vector
!!
!! \param d(:) Scaling vector
!! \param info return code
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_lz_base_scal(d,a,info,side)
import
class(psb_lz_base_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lz_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_lz_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_lz_base_maxval(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lz_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_lz_base_csnmi(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lz_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_lz_base_csnm1(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_lz_base_rowsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_lz_base_arwsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_lz_base_colsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_lz_base_aclsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_aclsum
end interface
! == ===============
!
! COO interfaces
!
! == ===============
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_lz_coo_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_lz_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lz_coo_reallocate_nz
end interface
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_lz_coo_reinit(a,clear)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lz_coo_reinit
end interface
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_lz_coo_trim(a)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
end subroutine psb_lz_coo_trim
end interface
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_clean_zeros
!
interface
subroutine psb_lz_coo_clean_zeros(a,info)
import
class(psb_lz_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_coo_clean_zeros
end interface
!
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_lz_coo_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lz_coo_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lz_coo_allocate_mnnz
end interface
!> \memberof psb_lz_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lz_coo_mold(a,b,info)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
class(psb_lz_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_coo_mold
end interface
!
!> Function print.
!! \memberof psb_lz_coo_sparse_mat
!! \brief Print the matrix to file in MatrixMarket format
!!
!! \param iout The unit to write to
!! \param iv [none] Renumbering for both rows and columns
!! \param head [none] Descriptive header for the file
!! \param ivr [none] Row renumbering
!! \param ivc [none] Col renumbering
!!
!
interface
subroutine psb_lz_coo_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_lz_coo_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lz_coo_print
end interface
!
!> Function get_nz_row.
!! \memberof psb_lz_coo_sparse_mat
!! \brief How many nonzeros in a row?
!!
!! \param idx The row to search.
!! \param idx The row to search.
!!
!
interface
@ -3627,138 +3193,6 @@ module psb_z_base_mat_mod
end subroutine psb_lz_coo_csgetrow
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cssv
interface
subroutine psb_lz_coo_cssv(alpha,a,x,beta,y,info,trans)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_coo_cssv
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cssm
interface
subroutine psb_lz_coo_cssm(alpha,a,x,beta,y,info,trans)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_coo_cssm
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csmv
interface
subroutine psb_lz_coo_csmv(alpha,a,x,beta,y,info,trans)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:)
complex(psb_dpk_), intent(inout) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_coo_csmv
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csmm
interface
subroutine psb_lz_coo_csmm(alpha,a,x,beta,y,info,trans)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
complex(psb_dpk_), intent(inout) :: y(:,:)
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_lz_coo_csmm
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_maxval
interface
function psb_lz_coo_maxval(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_maxval
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csnmi
interface
function psb_lz_coo_csnmi(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_csnmi
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csnm1
interface
function psb_lz_coo_csnm1(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_csnm1
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_rowsum
interface
subroutine psb_lz_coo_rowsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_rowsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_arwsum
interface
subroutine psb_lz_coo_arwsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_arwsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_colsum
interface
subroutine psb_lz_coo_colsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_colsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_aclsum
interface
subroutine psb_lz_coo_aclsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_aclsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_get_diag
@ -3771,6 +3205,7 @@ module psb_z_base_mat_mod
end subroutine psb_lz_coo_get_diag
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scal
@ -3796,7 +3231,6 @@ module psb_z_base_mat_mod
end subroutine psb_lz_coo_scals
end interface
contains
@ -3818,7 +3252,7 @@ contains
implicit none
class(psb_z_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_ip
res = res + (2*psb_sizeof_dp) * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%ia)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -4042,7 +3476,7 @@ contains
implicit none
class(psb_lz_coo_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8 + 1
res = 3*psb_sizeof_lp
res = res + (2*psb_sizeof_dp) * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%ia)
res = res + psb_sizeof_lp * psb_size(a%ja)

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

@ -495,6 +495,334 @@ module psb_z_csr_mat_mod
end interface
!> \namespace psb_base_mod \class psb_lz_csr_sparse_mat
!! \extends psb_lz_base_mat_mod::psb_lz_base_sparse_mat
!!
!! psb_lz_csr_sparse_mat type and the related methods.
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_lz_base_sparse_mat) :: psb_lz_csr_sparse_mat
!> Pointers to beginning of rows in JA and VAL.
integer(psb_lpk_), allocatable :: irp(:)
!> Column indices.
integer(psb_lpk_), allocatable :: ja(:)
!> Coefficient values.
complex(psb_dpk_), allocatable :: val(:)
contains
procedure, pass(a) :: is_by_rows => lz_csr_is_by_rows
procedure, pass(a) :: get_size => lz_csr_get_size
procedure, pass(a) :: get_nzeros => lz_csr_get_nzeros
procedure, nopass :: get_fmt => lz_csr_get_fmt
procedure, pass(a) :: sizeof => lz_csr_sizeof
procedure, pass(a) :: reallocate_nz => psb_lz_csr_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lz_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lz_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => psb_lz_cp_csr_from_coo
procedure, pass(a) :: cp_to_fmt => psb_lz_cp_csr_to_fmt
procedure, pass(a) :: cp_from_fmt => psb_lz_cp_csr_from_fmt
procedure, pass(a) :: mv_to_coo => psb_lz_mv_csr_to_coo
procedure, pass(a) :: mv_from_coo => psb_lz_mv_csr_from_coo
procedure, pass(a) :: mv_to_fmt => psb_lz_mv_csr_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_csr_from_fmt
procedure, pass(a) :: csput_a => psb_lz_csr_csput_a
procedure, pass(a) :: get_diag => psb_lz_csr_get_diag
procedure, pass(a) :: csgetptn => psb_lz_csr_csgetptn
procedure, pass(a) :: csgetrow => psb_lz_csr_csgetrow
procedure, pass(a) :: get_nz_row => lz_csr_get_nz_row
procedure, pass(a) :: reinit => psb_lz_csr_reinit
procedure, pass(a) :: trim => psb_lz_csr_trim
procedure, pass(a) :: print => psb_lz_csr_print
procedure, pass(a) :: free => lz_csr_free
procedure, pass(a) :: mold => psb_lz_csr_mold
procedure, pass(a) :: scals => psb_lz_csr_scals
procedure, pass(a) :: scalv => psb_lz_csr_scal
end type psb_lz_csr_sparse_mat
private :: lz_csr_get_nzeros, lz_csr_free, lz_csr_get_fmt, &
& lz_csr_get_size, lz_csr_sizeof, lz_csr_get_nz_row, &
& lz_csr_is_by_rows
!> \memberof psb_lz_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_lz_csr_reallocate_nz(nz,a)
import
integer(psb_lpk_), intent(in) :: nz
class(psb_lz_csr_sparse_mat), intent(inout) :: a
end subroutine psb_lz_csr_reallocate_nz
end interface
!> \memberof psb_lz_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_lz_csr_reinit(a,clear)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
end subroutine psb_lz_csr_reinit
end interface
!> \memberof psb_lz_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_lz_csr_trim(a)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
end subroutine psb_lz_csr_trim
end interface
!> \memberof psb_lz_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_lz_csr_mold(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_base_sparse_mat), intent(inout), allocatable :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csr_mold
end interface
!> \memberof psb_lz_csr_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_lz_csr_allocate_mnnz(m,n,a,nz)
import
integer(psb_lpk_), intent(in) :: m,n
class(psb_lz_csr_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
end subroutine psb_lz_csr_allocate_mnnz
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_print
interface
subroutine psb_lz_csr_print(iout,a,iv,head,ivr,ivc)
import
integer(psb_ipk_), intent(in) :: iout
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
end subroutine psb_lz_csr_print
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_to_coo
interface
subroutine psb_lz_cp_csr_to_coo(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_csr_to_coo
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_coo
interface
subroutine psb_lz_cp_csr_from_coo(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_csr_from_coo
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_to_fmt
interface
subroutine psb_lz_cp_csr_to_fmt(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_csr_to_fmt
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from_fmt
interface
subroutine psb_lz_cp_csr_from_fmt(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_base_sparse_mat), intent(in) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_cp_csr_from_fmt
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_mv_to_coo
interface
subroutine psb_lz_mv_csr_to_coo(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_mv_csr_to_coo
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_mv_from_coo
interface
subroutine psb_lz_mv_csr_from_coo(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_mv_csr_from_coo
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_mv_to_fmt
interface
subroutine psb_lz_mv_csr_to_fmt(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_mv_csr_to_fmt
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_mv_from_fmt
interface
subroutine psb_lz_mv_csr_from_fmt(a,b,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
class(psb_lz_base_sparse_mat), intent(inout) :: b
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_mv_csr_from_fmt
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_cp_from
interface
subroutine psb_lz_csr_cp_from(a,b)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
type(psb_lz_csr_sparse_mat), intent(in) :: b
end subroutine psb_lz_csr_cp_from
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_mv_from
interface
subroutine psb_lz_csr_mv_from(a,b)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
type(psb_lz_csr_sparse_mat), intent(inout) :: b
end subroutine psb_lz_csr_mv_from
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csput_a
interface
subroutine psb_lz_csr_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: val(:)
integer(psb_lpk_), intent(in) :: nz,ia(:), ja(:),&
& imin,imax,jmin,jmax
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: gtl(:)
end subroutine psb_lz_csr_csput_a
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_lz_csr_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csr_csgetptn
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csgetrow
interface
subroutine psb_lz_csr_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
complex(psb_dpk_), allocatable, intent(inout) :: val(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csr_csgetrow
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_csgetblk
interface
subroutine psb_lz_csr_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(inout) :: b
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_lz_csr_csgetblk
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_get_diag
interface
subroutine psb_lz_csr_get_diag(a,d,info)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csr_get_diag
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scal
interface
subroutine psb_lz_csr_scal(d,a,info,side)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_lz_csr_scal
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scals
interface
subroutine psb_lz_csr_scals(d,a,info)
import
class(psb_lz_csr_sparse_mat), intent(inout) :: a
complex(psb_dpk_), intent(in) :: d
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csr_scals
end interface
contains
@ -525,7 +853,7 @@ contains
implicit none
class(psb_z_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 8
res = 2 * psb_sizeof_ip
res = res + (2*psb_sizeof_dp) * psb_size(a%val)
res = res + psb_sizeof_ip * psb_size(a%irp)
res = res + psb_sizeof_ip * psb_size(a%ja)
@ -614,4 +942,120 @@ contains
end subroutine z_csr_free
! == ===================================
!
!
!
! Getters
!
!
!
!
!
! == ===================================
function lz_csr_is_by_rows(a) result(res)
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
logical :: res
res = .true.
end function lz_csr_is_by_rows
function lz_csr_sizeof(a) result(res)
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_epk_) :: res
res = 2 * psb_sizeof_lp
res = res + (2*psb_sizeof_dp) * psb_size(a%val)
res = res + psb_sizeof_lp * psb_size(a%irp)
res = res + psb_sizeof_lp * psb_size(a%ja)
end function lz_csr_sizeof
function lz_csr_get_fmt() result(res)
implicit none
character(len=5) :: res
res = 'CSR'
end function lz_csr_get_fmt
function lz_csr_get_nzeros(a) result(res)
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = a%irp(a%get_nrows()+1)-1
end function lz_csr_get_nzeros
function lz_csr_get_size(a) result(res)
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
res = -1
if (allocated(a%ja)) then
res = size(a%ja)
end if
if (allocated(a%val)) then
if (res >= 0) then
res = min(res,size(a%val))
else
res = size(a%val)
end if
end if
end function lz_csr_get_size
function lz_csr_get_nz_row(idx,a) result(res)
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_) :: res
res = 0
if ((1<=idx).and.(idx<=a%get_nrows())) then
res = a%irp(idx+1)-a%irp(idx)
end if
end function lz_csr_get_nz_row
! == ===================================
!
!
!
! Data management
!
!
!
!
!
! == ===================================
subroutine lz_csr_free(a)
implicit none
class(psb_lz_csr_sparse_mat), intent(inout) :: a
if (allocated(a%irp)) deallocate(a%irp)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
call a%set_null()
call a%set_nrows(0_psb_lpk_)
call a%set_ncols(0_psb_lpk_)
return
end subroutine lz_csr_free
end module psb_z_csr_mat_mod

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

@ -72,8 +72,8 @@
module psb_z_mat_mod
use psb_z_base_mat_mod
use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat
use psb_z_csc_mat_mod, only : psb_z_csc_sparse_mat
use psb_z_csr_mat_mod, only : psb_z_csr_sparse_mat, psb_lz_csr_sparse_mat
use psb_z_csc_mat_mod, only : psb_z_csc_sparse_mat
type :: psb_zspmat_type

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

@ -203,6 +203,69 @@ module psb_z_serial_mod
end subroutine psb_z_aspxpby
end interface psb_aspxpby
interface psb_spspmm
!!$ subroutine psb_zspspmm(a,b,c,info)
!!$ use psb_z_mat_mod, only : psb_zspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_zspmat_type), intent(in) :: a,b
!!$ type(psb_zspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_zspspmm
subroutine psb_lzcsrspspmm(a,b,c,info)
use psb_z_mat_mod, only : psb_lz_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a,b
type(psb_lz_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzcsrspspmm
!!$ subroutine psb_zcscspspmm(a,b,c,info)
!!$ use psb_z_mat_mod, only : psb_z_csc_sparse_mat
!!$ import :: psb_ipk_
!!$ implicit none
!!$ class(psb_z_csc_sparse_mat), intent(in) :: a,b
!!$ type(psb_z_csc_sparse_mat), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_zcscspspmm
end interface psb_spspmm
interface psb_symbmm
!!$ subroutine psb_zsymbmm(a,b,c,info)
!!$ use psb_z_mat_mod, only : psb_zspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_zspmat_type), intent(in) :: a,b
!!$ type(psb_zspmat_type), intent(out) :: c
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psb_zsymbmm
subroutine psb_lzbase_symbmm(a,b,c,info)
use psb_z_mat_mod, only : psb_lz_base_sparse_mat, psb_lz_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lz_base_sparse_mat), intent(in) :: a,b
type(psb_lz_csr_sparse_mat), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lzbase_symbmm
end interface psb_symbmm
interface psb_numbmm
!!$ subroutine psb_znumbmm(a,b,c)
!!$ use psb_z_mat_mod, only : psb_zspmat_type
!!$ import :: psb_ipk_
!!$ implicit none
!!$ type(psb_zspmat_type), intent(in) :: a,b
!!$ type(psb_zspmat_type), intent(inout) :: c
!!$ end subroutine psb_znumbmm
subroutine psb_lzbase_numbmm(a,b,c)
use psb_z_mat_mod, only : psb_lz_base_sparse_mat, psb_lz_csr_sparse_mat
import :: psb_ipk_
implicit none
class(psb_lz_base_sparse_mat), intent(in) :: a,b
type(psb_lz_csr_sparse_mat), intent(inout) :: c
end subroutine psb_lzbase_numbmm
end interface psb_numbmm
contains
subroutine psb_zcsprt(iout,a,iv,head,ivr,ivc)

23
base/serial/impl/Makefile
Unescape Escape View File

@ -4,16 +4,21 @@ include ../../../Make.inc
# The object files
#
BOBJS=psb_base_mat_impl.o \
psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o \
psb_s_base_mat_impl.o psb_d_base_mat_impl.o psb_c_base_mat_impl.o psb_z_base_mat_impl.o
#\
psb_s_lbase_mat_impl.o psb_d_lbase_mat_impl.o psb_c_lbase_mat_impl.o psb_z_lbase_mat_impl.o
SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o \
psb_s_lcoo_impl.o
DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o \
psb_d_lcoo_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o \
psb_c_lcoo_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o \
psb_z_lcoo_impl.o
SOBJS=psb_s_csr_impl.o psb_s_coo_impl.o psb_s_csc_impl.o psb_s_mat_impl.o
#\
psb_s_lcoo_impl.o psb_s_lcsr_impl.o
DOBJS=psb_d_csr_impl.o psb_d_coo_impl.o psb_d_csc_impl.o psb_d_mat_impl.o
#\
psb_d_lcoo_impl.o psb_d_lcsr_impl.o
COBJS=psb_c_csr_impl.o psb_c_coo_impl.o psb_c_csc_impl.o psb_c_mat_impl.o
#\
psb_c_lcoo_impl.o psb_c_lcsr_impl.o
ZOBJS=psb_z_csr_impl.o psb_z_coo_impl.o psb_z_csc_impl.o psb_z_mat_impl.o
#\
psb_z_lcoo_impl.o psb_z_lcsr_impl.o
OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)

296
base/serial/impl/psb_base_mat_impl.f90
Unescape Escape View File

@ -293,3 +293,299 @@ subroutine psb_base_trim(a)
end subroutine psb_base_trim
function psb_lbase_get_nz_row(idx,a) result(res)
use psb_error_mod
use psb_base_mat_mod, psb_protect_name => psb_lbase_get_nz_row
implicit none
integer(psb_lpk_), intent(in) :: idx
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='lbase_get_nz_row'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the lbase version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_lbase_get_nz_row
function psb_lbase_get_nzeros(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_lbase_get_nzeros
use psb_error_mod
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='lbase_get_nzeros'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_lbase_get_nzeros
function psb_lbase_get_size(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_lbase_get_size
use psb_error_mod
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_lbase_get_size
subroutine psb_lbase_reinit(a,clear)
use psb_base_mat_mod, psb_protect_name => psb_lbase_reinit
use psb_error_mod
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='reinit'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_reinit
subroutine psb_lbase_sparse_print(iout,a,iv,head,ivr,ivc)
use psb_base_mat_mod, psb_protect_name => psb_lbase_sparse_print
use psb_error_mod
implicit none
integer(psb_lpk_), intent(in) :: iout
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_lpk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_sparse_print
subroutine psb_lbase_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_base_mat_mod, psb_protect_name => psb_lbase_csgetptn
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: imin,imax
integer(psb_lpk_), intent(out) :: nz
integer(psb_lpk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_lpk_), intent(in), optional :: iren(:)
integer(psb_lpk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_csgetptn
subroutine psb_lbase_get_neigh(a,idx,neigh,n,info,lev)
use psb_base_mat_mod, psb_protect_name => psb_lbase_get_neigh
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_lbase_sparse_mat), intent(in) :: a
integer(psb_lpk_), intent(in) :: idx
integer(psb_lpk_), intent(out) :: n
integer(psb_lpk_), allocatable, intent(out) :: neigh(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), optional, intent(in) :: lev
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: lev_, i, nl, ifl,ill,&
& nn, nidx,ntl,ma, n1
integer(psb_lpk_), allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if(present(lev)) then
lev_ = lev
else
lev_=1
end if
! Turns out we can write get_neigh at this
! level
n = 0
ma = a%get_nrows()
call a%csget(idx,idx,n,ia,ja,info)
if (info == psb_success_) call psb_realloc(n,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= ma)) then
call a%csget(nidx,nidx,nn,ia,ja,info)
if (info == psb_success_) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
end do
call psb_msort_unique(neigh(ill+1:ill+ntl),nn,dir=psb_sort_up_)
ifl = ill + 1
ill = ill + nn
end do
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
n = nn
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lbase_get_neigh
subroutine psb_lbase_allocate_mnnz(m,n,a,nz)
use psb_base_mat_mod, psb_protect_name => psb_lbase_allocate_mnnz
use psb_error_mod
implicit none
integer(psb_lpk_), intent(in) :: m,n
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_lpk_), intent(in), optional :: nz
integer(psb_ipk_) :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_allocate_mnnz
subroutine psb_lbase_reallocate_nz(nz,a)
use psb_base_mat_mod, psb_protect_name => psb_lbase_reallocate_nz
use psb_error_mod
implicit none
integer(psb_lpk_), intent(in) :: nz
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_reallocate_nz
subroutine psb_lbase_free(a)
use psb_base_mat_mod, psb_protect_name => psb_lbase_free
use psb_error_mod
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lbase_free
subroutine psb_lbase_trim(a)
use psb_base_mat_mod, psb_protect_name => psb_lbase_trim
use psb_error_mod
implicit none
class(psb_lbase_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='trim'
logical, parameter :: debug=.false.
!
! This is the base version.
! The correct action is: do nothing.
! Indeed, the more complicated the data structure, the
! more likely this is the only possible course.
!
return
end subroutine psb_lbase_trim

1787
base/serial/impl/psb_c_base_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

2782
base/serial/impl/psb_c_coo_impl.f90
View File

File diff suppressed because it is too large Load Diff

1667
base/serial/impl/psb_c_csr_impl.f90
View File

File diff suppressed because it is too large Load Diff

64
base/serial/impl/psb_c_lbase_mat_impl.F90
Unescape Escape View File

@ -243,7 +243,7 @@ subroutine psb_lc_base_mv_from_coo(a,b,info)
call psb_erractionrestore(err_act)
return
8
9999 call psb_error_handler(err_act)
return
@ -2032,15 +2032,29 @@ subroutine psb_lc_base_cp_to_icoo(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%mv_to_icoo(b,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_cp_to_icoo
@ -2054,17 +2068,31 @@ subroutine psb_lc_base_cp_from_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo'
character(len=20) :: name='from_icoo'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call tmp%cp_from_icoo(b,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_cp_from_icoo
@ -2290,7 +2318,3 @@ subroutine psb_lc_base_mv_from_ifmt(a,b,info)
end subroutine psb_lc_base_mv_from_ifmt

16
base/serial/impl/psb_c_lcoo_impl.f90
Unescape Escape View File

@ -3339,7 +3339,7 @@ subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
integer(psb_lpk_), allocatable :: iaux(:), ias(:),jas(:), ix2(:)
complex(psb_spk_), allocatable :: vs(:)
integer(psb_lpk_) :: nza
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act, inzin
integer(psb_lpk_) :: i,j, irw, icl, ip,is, imx, k, ii
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo'
@ -3617,10 +3617,11 @@ subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
!
! If we did not have enough memory for buffers,
! let's try in place.
!
call psi_msort_up(nzin,ia(1:),iaux(1:),iret)
!
inzin = nzin
call psi_msort_up(inzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -3933,9 +3934,10 @@ subroutine psb_lc_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call psi_msort_up(nzin,ja(1:),iaux(1:),iret)
inzin = nzin
call psi_msort_up(inzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -4045,7 +4047,7 @@ subroutine psb_lc_cp_coo_to_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nz
integer(psb_ipk_) :: nz
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.

1787
base/serial/impl/psb_d_base_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

2782
base/serial/impl/psb_d_coo_impl.f90
View File

File diff suppressed because it is too large Load Diff

1667
base/serial/impl/psb_d_csr_impl.f90
View File

File diff suppressed because it is too large Load Diff

64
base/serial/impl/psb_d_lbase_mat_impl.F90
Unescape Escape View File

@ -243,7 +243,7 @@ subroutine psb_ld_base_mv_from_coo(a,b,info)
call psb_erractionrestore(err_act)
return
8
9999 call psb_error_handler(err_act)
return
@ -2032,15 +2032,29 @@ subroutine psb_ld_base_cp_to_icoo(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%mv_to_icoo(b,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_cp_to_icoo
@ -2054,17 +2068,31 @@ subroutine psb_ld_base_cp_from_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo'
character(len=20) :: name='from_icoo'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call tmp%cp_from_icoo(b,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_cp_from_icoo
@ -2290,7 +2318,3 @@ subroutine psb_ld_base_mv_from_ifmt(a,b,info)
end subroutine psb_ld_base_mv_from_ifmt

16
base/serial/impl/psb_d_lcoo_impl.f90
Unescape Escape View File

@ -3339,7 +3339,7 @@ subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
integer(psb_lpk_), allocatable :: iaux(:), ias(:),jas(:), ix2(:)
real(psb_dpk_), allocatable :: vs(:)
integer(psb_lpk_) :: nza
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act, inzin
integer(psb_lpk_) :: i,j, irw, icl, ip,is, imx, k, ii
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo'
@ -3617,10 +3617,11 @@ subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
!
! If we did not have enough memory for buffers,
! let's try in place.
!
call psi_msort_up(nzin,ia(1:),iaux(1:),iret)
!
inzin = nzin
call psi_msort_up(inzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -3933,9 +3934,10 @@ subroutine psb_ld_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call psi_msort_up(nzin,ja(1:),iaux(1:),iret)
inzin = nzin
call psi_msort_up(inzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -4045,7 +4047,7 @@ subroutine psb_ld_cp_coo_to_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nz
integer(psb_ipk_) :: nz
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.

1787
base/serial/impl/psb_s_base_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

2782
base/serial/impl/psb_s_coo_impl.f90
View File

File diff suppressed because it is too large Load Diff

1667
base/serial/impl/psb_s_csr_impl.f90
View File

File diff suppressed because it is too large Load Diff

64
base/serial/impl/psb_s_lbase_mat_impl.F90
Unescape Escape View File

@ -243,7 +243,7 @@ subroutine psb_ls_base_mv_from_coo(a,b,info)
call psb_erractionrestore(err_act)
return
8
9999 call psb_error_handler(err_act)
return
@ -2032,15 +2032,29 @@ subroutine psb_ls_base_cp_to_icoo(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%mv_to_icoo(b,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_cp_to_icoo
@ -2054,17 +2068,31 @@ subroutine psb_ls_base_cp_from_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo'
character(len=20) :: name='from_icoo'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call tmp%cp_from_icoo(b,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_cp_from_icoo
@ -2290,7 +2318,3 @@ subroutine psb_ls_base_mv_from_ifmt(a,b,info)
end subroutine psb_ls_base_mv_from_ifmt

16
base/serial/impl/psb_s_lcoo_impl.f90
Unescape Escape View File

@ -3339,7 +3339,7 @@ subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
integer(psb_lpk_), allocatable :: iaux(:), ias(:),jas(:), ix2(:)
real(psb_spk_), allocatable :: vs(:)
integer(psb_lpk_) :: nza
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act, inzin
integer(psb_lpk_) :: i,j, irw, icl, ip,is, imx, k, ii
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo'
@ -3617,10 +3617,11 @@ subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
!
! If we did not have enough memory for buffers,
! let's try in place.
!
call psi_msort_up(nzin,ia(1:),iaux(1:),iret)
!
inzin = nzin
call psi_msort_up(inzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -3933,9 +3934,10 @@ subroutine psb_ls_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call psi_msort_up(nzin,ja(1:),iaux(1:),iret)
inzin = nzin
call psi_msort_up(inzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -4045,7 +4047,7 @@ subroutine psb_ls_cp_coo_to_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nz
integer(psb_ipk_) :: nz
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.

1787
base/serial/impl/psb_z_base_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

2782
base/serial/impl/psb_z_coo_impl.f90
View File

File diff suppressed because it is too large Load Diff

1667
base/serial/impl/psb_z_csr_impl.f90
View File

File diff suppressed because it is too large Load Diff

64
base/serial/impl/psb_z_lbase_mat_impl.F90
Unescape Escape View File

@ -243,7 +243,7 @@ subroutine psb_lz_base_mv_from_coo(a,b,info)
call psb_erractionrestore(err_act)
return
8
9999 call psb_error_handler(err_act)
return
@ -2032,15 +2032,29 @@ subroutine psb_lz_base_cp_to_icoo(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call a%cp_to_coo(tmp,info)
if (info == psb_success_) call tmp%mv_to_icoo(b,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_cp_to_icoo
@ -2054,17 +2068,31 @@ subroutine psb_lz_base_cp_from_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_coo'
character(len=20) :: name='from_icoo'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
call tmp%cp_from_icoo(b,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_cp_from_icoo
@ -2290,7 +2318,3 @@ subroutine psb_lz_base_mv_from_ifmt(a,b,info)
end subroutine psb_lz_base_mv_from_ifmt

16
base/serial/impl/psb_z_lcoo_impl.f90
Unescape Escape View File

@ -3339,7 +3339,7 @@ subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
integer(psb_lpk_), allocatable :: iaux(:), ias(:),jas(:), ix2(:)
complex(psb_dpk_), allocatable :: vs(:)
integer(psb_lpk_) :: nza
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act
integer(psb_ipk_) :: iret, nzl,idir_, dupl_, err_act, inzin
integer(psb_lpk_) :: i,j, irw, icl, ip,is, imx, k, ii
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name = 'psb_fixcoo'
@ -3617,10 +3617,11 @@ subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
!
! If we did not have enough memory for buffers,
! let's try in place.
!
call psi_msort_up(nzin,ia(1:),iaux(1:),iret)
!
inzin = nzin
call psi_msort_up(inzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -3933,9 +3934,10 @@ subroutine psb_lz_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call psi_msort_up(nzin,ja(1:),iaux(1:),iret)
inzin = nzin
call psi_msort_up(inzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
& call psb_ip_reord(inzin,val,ia,ja,iaux)
i = 1
j = i
do while (i <= nzin)
@ -4045,7 +4047,7 @@ subroutine psb_lz_cp_coo_to_icoo(a,b,info)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
integer(psb_lpk_) :: nz
integer(psb_ipk_) :: nz
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.

Write Preview
Loading…
Cancel
Save