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

158
prec/psb_dilu_fct.f90
Unescape Escape View File

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

154
prec/psb_silu_fct.f90
Unescape Escape View File

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

154
prec/psb_zilu_fct.f90
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save