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

psblas3

Browse Source 
prec/psb_cilu_fct.f90
 prec/psb_dilu_fct.f90
 prec/psb_silu_fct.f90
 prec/psb_zilu_fct.f90

"Dirty trick" to speed up factorization when input is already in CSR.
psblas3-type-indexed
Salvatore Filippone 15 years ago
parent e307e0a22e
commit 802546ceb3
4 changed files with 402 additions and 234 deletions
Show Stats Download Patch File Download Diff File

154
prec/psb_cilu_fct.f90
Unescape Escape View File

@ -152,36 +152,57 @@ contains
! !
! !
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => a%a)
irb = min(ma-i+1,nrb) type is (psb_c_csr_sparse_mat)
call a%a%csget(i,i+irb-1,trw,info) do j = aa%irp(i), aa%irp(i+1) - 1
if(info /= 0) then k = aa%ja(j)
info=4010 ! write(0,*)'KKKKK',k
ch_err='a%csget' if ((k < i).and.(k >= 1)) then
call psb_errpush(info,name,a_err=ch_err) l1 = l1 + 1
goto 9999 laspk(l1) = aa%val(j)
end if lia1(l1) = k
nz = trw%get_nzeros() else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call a%a%csget(i,i+irb-1,trw,info)
k = trw%ja(ktrw) if(info /= 0) then
if ((k < i).and.(k >= 1)) then info=4010
l1 = l1 + 1 ch_err='a%csget'
laspk(l1) = trw%val(ktrw) call psb_errpush(info,name,a_err=ch_err)
lia1(l1) = k goto 9999
else if (k == i) then end if
d(i) = trw%val(ktrw) nz = trw%get_nzeros()
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
!!$ !!$
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -269,36 +290,57 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = czero d(i) = czero
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => b%a)
irb = min(ma-i+1,nrb) type is (psb_c_csr_sparse_mat)
call b%a%csget(i-ma,i-ma+irb-1,trw,info) do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
nz = trw%get_nzeros() k = aa%ja(j)
if(info /= 0) then ! write(0,*)'KKKKK',k
info=4010 if ((k < i).and.(k >= 1)) then
ch_err='a%csget' l1 = l1 + 1
call psb_errpush(info,name,a_err=ch_err) laspk(l1) = aa%val(j)
goto 9999 lia1(l1) = k
end if else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call b%a%csget(i-ma,i-ma+irb-1,trw,info)
k = trw%ja(ktrw) nz = trw%get_nzeros()
if ((k < i).and.(k >= 1)) then if(info /= 0) then
l1 = l1 + 1 info=4010
laspk(l1) = trw%val(ktrw) ch_err='a%csget'
lia1(l1) = k call psb_errpush(info,name,a_err=ch_err)
else if (k == i) then goto 9999
d(i) = trw%val(ktrw) end if
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1

158
prec/psb_dilu_fct.f90
Unescape Escape View File

@ -119,8 +119,8 @@ contains
implicit none implicit none
type(psb_d_sparse_mat) :: a type(psb_d_sparse_mat), target :: a
type(psb_d_sparse_mat) :: b type(psb_d_sparse_mat), target :: b
integer :: m,ma,mb,l1,l2,info integer :: m,ma,mb,l1,l2,info
integer, dimension(:) :: lia1,lia2,uia1,uia2 integer, dimension(:) :: lia1,lia2,uia1,uia2
real(psb_dpk_), dimension(:) :: laspk,uaspk,d real(psb_dpk_), dimension(:) :: laspk,uaspk,d
@ -155,36 +155,57 @@ contains
d(i) = dzero d(i) = dzero
! !
! !
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => a%a)
irb = min(ma-i+1,nrb) type is (psb_d_csr_sparse_mat)
call a%a%csget(i,i+irb-1,trw,info) do j = aa%irp(i), aa%irp(i+1) - 1
if(info /= 0) then k = aa%ja(j)
info=4010 ! write(0,*)'KKKKK',k
ch_err='a%csget' if ((k < i).and.(k >= 1)) then
call psb_errpush(info,name,a_err=ch_err) l1 = l1 + 1
goto 9999 laspk(l1) = aa%val(j)
end if lia1(l1) = k
nz = trw%get_nzeros() else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call a%a%csget(i,i+irb-1,trw,info)
k = trw%ja(ktrw) if(info /= 0) then
if ((k < i).and.(k >= 1)) then info=4010
l1 = l1 + 1 ch_err='a%csget'
laspk(l1) = trw%val(ktrw) call psb_errpush(info,name,a_err=ch_err)
lia1(l1) = k goto 9999
else if (k == i) then end if
d(i) = trw%val(ktrw) nz = trw%get_nzeros()
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
!!$ !!$
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -272,36 +293,57 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = dzero d(i) = dzero
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => b%a)
irb = min(ma-i+1,nrb) type is (psb_d_csr_sparse_mat)
call b%a%csget(i-ma,i-ma+irb-1,trw,info) do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
nz = trw%get_nzeros() k = aa%ja(j)
if(info /= 0) then ! write(0,*)'KKKKK',k
info=4010 if ((k < i).and.(k >= 1)) then
ch_err='a%csget' l1 = l1 + 1
call psb_errpush(info,name,a_err=ch_err) laspk(l1) = aa%val(j)
goto 9999 lia1(l1) = k
end if else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call b%a%csget(i-ma,i-ma+irb-1,trw,info)
k = trw%ja(ktrw) nz = trw%get_nzeros()
if ((k < i).and.(k >= 1)) then if(info /= 0) then
l1 = l1 + 1 info=4010
laspk(l1) = trw%val(ktrw) ch_err='a%csget'
lia1(l1) = k call psb_errpush(info,name,a_err=ch_err)
else if (k == i) then goto 9999
d(i) = trw%val(ktrw) end if
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1

154
prec/psb_silu_fct.f90
Unescape Escape View File

@ -154,36 +154,57 @@ contains
d(i) = szero d(i) = szero
! !
! !
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => a%a)
irb = min(ma-i+1,nrb) type is (psb_s_csr_sparse_mat)
call a%a%csget(i,i+irb-1,trw,info) do j = aa%irp(i), aa%irp(i+1) - 1
if(info /= 0) then k = aa%ja(j)
info=4010 ! write(0,*)'KKKKK',k
ch_err='a%csget' if ((k < i).and.(k >= 1)) then
call psb_errpush(info,name,a_err=ch_err) l1 = l1 + 1
goto 9999 laspk(l1) = aa%val(j)
end if lia1(l1) = k
nz = trw%get_nzeros() else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call a%a%csget(i,i+irb-1,trw,info)
k = trw%ja(ktrw) if(info /= 0) then
if ((k < i).and.(k >= 1)) then info=4010
l1 = l1 + 1 ch_err='a%csget'
laspk(l1) = trw%val(ktrw) call psb_errpush(info,name,a_err=ch_err)
lia1(l1) = k goto 9999
else if (k == i) then end if
d(i) = trw%val(ktrw) nz = trw%get_nzeros()
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
!!$ !!$
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -271,36 +292,57 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = szero d(i) = szero
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => b%a)
irb = min(ma-i+1,nrb) type is (psb_s_csr_sparse_mat)
call b%a%csget(i-ma,i-ma+irb-1,trw,info) do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
nz = trw%get_nzeros() k = aa%ja(j)
if(info /= 0) then ! write(0,*)'KKKKK',k
info=4010 if ((k < i).and.(k >= 1)) then
ch_err='a%csget' l1 = l1 + 1
call psb_errpush(info,name,a_err=ch_err) laspk(l1) = aa%val(j)
goto 9999 lia1(l1) = k
end if else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call b%a%csget(i-ma,i-ma+irb-1,trw,info)
k = trw%ja(ktrw) nz = trw%get_nzeros()
if ((k < i).and.(k >= 1)) then if(info /= 0) then
l1 = l1 + 1 info=4010
laspk(l1) = trw%val(ktrw) ch_err='a%csget'
lia1(l1) = k call psb_errpush(info,name,a_err=ch_err)
else if (k == i) then goto 9999
d(i) = trw%val(ktrw) end if
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1

154
prec/psb_zilu_fct.f90
Unescape Escape View File

@ -152,36 +152,57 @@ contains
! !
! !
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => a%a)
irb = min(ma-i+1,nrb) type is (psb_z_csr_sparse_mat)
call a%a%csget(i,i+irb-1,trw,info) do j = aa%irp(i), aa%irp(i+1) - 1
if(info /= 0) then k = aa%ja(j)
info=4010 ! write(0,*)'KKKKK',k
ch_err='a%csget' if ((k < i).and.(k >= 1)) then
call psb_errpush(info,name,a_err=ch_err) l1 = l1 + 1
goto 9999 laspk(l1) = aa%val(j)
end if lia1(l1) = k
nz = trw%get_nzeros() else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call a%a%csget(i,i+irb-1,trw,info)
k = trw%ja(ktrw) if(info /= 0) then
if ((k < i).and.(k >= 1)) then info=4010
l1 = l1 + 1 ch_err='a%csget'
laspk(l1) = trw%val(ktrw) call psb_errpush(info,name,a_err=ch_err)
lia1(l1) = k goto 9999
else if (k == i) then end if
d(i) = trw%val(ktrw) nz = trw%get_nzeros()
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
!!$ !!$
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1
@ -269,36 +290,57 @@ contains
do i = ma+1, m do i = ma+1, m
d(i) = zzero d(i) = zzero
if ((mod(i,nrb) == 1).or.(nrb==1)) then select type(aa => b%a)
irb = min(ma-i+1,nrb) type is (psb_z_csr_sparse_mat)
call b%a%csget(i-ma,i-ma+irb-1,trw,info) do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
nz = trw%get_nzeros() k = aa%ja(j)
if(info /= 0) then ! write(0,*)'KKKKK',k
info=4010 if ((k < i).and.(k >= 1)) then
ch_err='a%csget' l1 = l1 + 1
call psb_errpush(info,name,a_err=ch_err) laspk(l1) = aa%val(j)
goto 9999 lia1(l1) = k
end if else if (k == i) then
ktrw=1 d(i) = aa%val(j)
end if else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uia1(l2) = k
end if
enddo
class default
do if ((mod(i,nrb) == 1).or.(nrb==1)) then
if (ktrw > nz ) exit irb = min(ma-i+1,nrb)
if (trw%ia(ktrw) > i) exit call b%a%csget(i-ma,i-ma+irb-1,trw,info)
k = trw%ja(ktrw) nz = trw%get_nzeros()
if ((k < i).and.(k >= 1)) then if(info /= 0) then
l1 = l1 + 1 info=4010
laspk(l1) = trw%val(ktrw) ch_err='a%csget'
lia1(l1) = k call psb_errpush(info,name,a_err=ch_err)
else if (k == i) then goto 9999
d(i) = trw%val(ktrw) end if
else if ((k > i).and.(k <= m)) then ktrw=1
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if end if
ktrw = ktrw + 1
enddo do
if (ktrw > nz ) exit
if (trw%ia(ktrw) > i) exit
k = trw%ja(ktrw)
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = trw%val(ktrw)
lia1(l1) = k
else if (k == i) then
d(i) = trw%val(ktrw)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = trw%val(ktrw)
uia1(l2) = k
end if
ktrw = ktrw + 1
enddo
end select
lia2(i+1) = l1 + 1 lia2(i+1) = l1 + 1

Write Preview
Loading…
Cancel
Save