fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/mld_ciluk_fact.f90
 mlprec/impl/mld_cilut_fact.f90
 mlprec/impl/mld_diluk_fact.f90
 mlprec/impl/mld_dilut_fact.f90
 mlprec/impl/mld_siluk_fact.f90
 mlprec/impl/mld_silut_fact.f90
 mlprec/impl/mld_ziluk_fact.f90
 mlprec/impl/mld_zilut_fact.f90


Use new heap interface
This commit is contained in:
Salvatore Filippone
2015-05-03 15:01:00 +00:00
parent 47b2784049
commit cd6db8e3ed
8 changed files with 124 additions and 124 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/mld_ciluk_fact.f90
+14 -14
View File
@@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw
type(psb_i_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
@@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output
! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
@@ -492,11 +492,11 @@ contains
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz
@@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
select type (aa=> a%a)
type is (psb_c_csr_sparse_mat)
@@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
end do
@@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
ktrw = ktrw + 1
enddo
@@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination
! step.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -642,7 +642,7 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
@@ -667,7 +667,7 @@ contains
!
do
! Beware: (iret < 0) means that the heap is empty, not an error.
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) return
!
@@ -706,7 +706,7 @@ contains
! need to insert it more than once.
!
if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j))
end if
mlprec/impl/mld_cilut_fact.f90
+17 -17
View File
@@ -307,7 +307,7 @@ contains
real(psb_spk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_i_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_cilut_factint'
character(len=20) :: ch_err
@@ -517,7 +517,7 @@ contains
real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
@@ -529,7 +529,7 @@ contains
info = psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -559,7 +559,7 @@ contains
k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -702,10 +702,10 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_), intent(in) :: thres,nrmi
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
@@ -724,7 +724,7 @@ contains
!
do
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) exit
!
@@ -772,7 +772,7 @@ contains
!
! Do the insertion.
!
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
endif
end do
@@ -903,7 +903,7 @@ contains
complex(psb_spk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_scomplex_idx_heap) :: heap
type(psb_c_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
@@ -921,7 +921,7 @@ contains
! is the largest absolute value.
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
@@ -953,7 +953,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -971,7 +971,7 @@ contains
else
nz = nlw+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first')
@@ -1058,7 +1058,7 @@ contains
! Now the upper part
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -1090,7 +1090,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -1112,7 +1112,7 @@ contains
fndmaxup = .false.
nz = nup+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
xw(k) = witem
xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true.
mlprec/impl/mld_diluk_fact.f90
+14 -14
View File
@@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw
type(psb_i_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err
@@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output
! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
@@ -492,11 +492,11 @@ contains
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz
@@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
select type (aa=> a%a)
type is (psb_d_csr_sparse_mat)
@@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
end do
@@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
ktrw = ktrw + 1
enddo
@@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination
! step.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -642,7 +642,7 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
@@ -667,7 +667,7 @@ contains
!
do
! Beware: (iret < 0) means that the heap is empty, not an error.
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) return
!
@@ -706,7 +706,7 @@ contains
! need to insert it more than once.
!
if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j))
end if
mlprec/impl/mld_dilut_fact.f90
+17 -17
View File
@@ -307,7 +307,7 @@ contains
real(psb_dpk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_i_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_dilut_factint'
character(len=20) :: ch_err
@@ -517,7 +517,7 @@ contains
real(psb_dpk_), intent(inout) :: nrmi
real(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
@@ -529,7 +529,7 @@ contains
info = psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -559,7 +559,7 @@ contains
k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -702,10 +702,10 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_), intent(in) :: thres,nrmi
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
@@ -724,7 +724,7 @@ contains
!
do
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) exit
!
@@ -772,7 +772,7 @@ contains
!
! Do the insertion.
!
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
endif
end do
@@ -903,7 +903,7 @@ contains
real(psb_dpk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_dreal_idx_heap) :: heap
type(psb_d_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
@@ -921,7 +921,7 @@ contains
! is the largest absolute value.
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
@@ -953,7 +953,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -971,7 +971,7 @@ contains
else
nz = nlw+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first')
@@ -1058,7 +1058,7 @@ contains
! Now the upper part
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -1090,7 +1090,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -1112,7 +1112,7 @@ contains
fndmaxup = .false.
nz = nup+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
xw(k) = witem
xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true.
mlprec/impl/mld_siluk_fact.f90
+14 -14
View File
@@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw
type(psb_i_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err
@@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output
! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
@@ -492,11 +492,11 @@ contains
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz
@@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
select type (aa=> a%a)
type is (psb_s_csr_sparse_mat)
@@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
end do
@@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
ktrw = ktrw + 1
enddo
@@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination
! step.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -642,7 +642,7 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
@@ -667,7 +667,7 @@ contains
!
do
! Beware: (iret < 0) means that the heap is empty, not an error.
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) return
!
@@ -706,7 +706,7 @@ contains
! need to insert it more than once.
!
if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j))
end if
mlprec/impl/mld_silut_fact.f90
+17 -17
View File
@@ -307,7 +307,7 @@ contains
real(psb_spk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_i_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_silut_factint'
character(len=20) :: ch_err
@@ -517,7 +517,7 @@ contains
real(psb_spk_), intent(inout) :: nrmi
real(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
@@ -529,7 +529,7 @@ contains
info = psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -559,7 +559,7 @@ contains
k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -702,10 +702,10 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_spk_), intent(in) :: thres,nrmi
real(psb_spk_), intent(in) :: thres,nrmi
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
@@ -724,7 +724,7 @@ contains
!
do
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) exit
!
@@ -772,7 +772,7 @@ contains
!
! Do the insertion.
!
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
endif
end do
@@ -903,7 +903,7 @@ contains
real(psb_spk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_sreal_idx_heap) :: heap
type(psb_s_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
@@ -921,7 +921,7 @@ contains
! is the largest absolute value.
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
@@ -953,7 +953,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -971,7 +971,7 @@ contains
else
nz = nlw+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first')
@@ -1058,7 +1058,7 @@ contains
! Now the upper part
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -1090,7 +1090,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -1112,7 +1112,7 @@ contains
fndmaxup = .false.
nz = nup+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
xw(k) = witem
xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true.
mlprec/impl/mld_ziluk_fact.f90
+14 -14
View File
@@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw
type(psb_i_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err
@@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output
! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero
! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out)
@@ -492,11 +492,11 @@ contains
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_z_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz
@@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
select type (aa=> a%a)
type is (psb_z_csr_sparse_mat)
@@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
end do
@@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)
rowlevs(k) = 0
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
end if
ktrw = ktrw + 1
enddo
@@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination
! step.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -642,7 +642,7 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:)
@@ -667,7 +667,7 @@ contains
!
do
! Beware: (iret < 0) means that the heap is empty, not an error.
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) return
!
@@ -706,7 +706,7 @@ contains
! need to insert it more than once.
!
if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j))
end if
mlprec/impl/mld_zilut_fact.f90
+17 -17
View File
@@ -307,7 +307,7 @@ contains
real(psb_dpk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
type(psb_i_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_zilut_factint'
character(len=20) :: ch_err
@@ -517,7 +517,7 @@ contains
real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40
@@ -529,7 +529,7 @@ contains
info = psb_success_
call psb_erractionsave(err_act)
call psb_init_heap(heap,info)
call heap%init(info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -559,7 +559,7 @@ contains
k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info)
call heap%insert(k,info)
if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1
if (k>jd) then
@@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row.
! heap - type(psb_int_heap), input/output.
! heap - type(psb_i_heap), input/output.
! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains
@@ -702,10 +702,10 @@ contains
implicit none
! Arguments
type(psb_int_heap), intent(inout) :: heap
type(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info
real(psb_dpk_), intent(in) :: thres,nrmi
real(psb_dpk_), intent(in) :: thres,nrmi
integer(psb_ipk_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
@@ -724,7 +724,7 @@ contains
!
do
call psb_heap_get_first(k,heap,iret)
call heap%get_first(k,iret)
if (iret < 0) exit
!
@@ -772,7 +772,7 @@ contains
!
! Do the insertion.
!
call psb_insert_heap(j,heap,info)
call heap%insert(j,info)
if (info /= psb_success_) return
endif
end do
@@ -903,7 +903,7 @@ contains
complex(psb_dpk_) :: witem
integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz
type(psb_dcomplex_idx_heap) :: heap
type(psb_z_idx_heap) :: heap
character(len=20), parameter :: name='ilut_copyout'
character(len=20) :: ch_err
logical :: fndmaxup
@@ -921,7 +921,7 @@ contains
! is the largest absolute value.
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then
@@ -953,7 +953,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -971,7 +971,7 @@ contains
else
nz = nlw+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first')
@@ -1058,7 +1058,7 @@ contains
! Now the upper part
!
call psb_init_heap(heap,info,dir=psb_asort_down_)
call heap%init(info,dir=psb_asort_down_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap')
@@ -1090,7 +1090,7 @@ contains
nz = nz + 1
xw(nz) = witem
xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info)
call heap%insert(witem,widx,info)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap')
@@ -1112,7 +1112,7 @@ contains
fndmaxup = .false.
nz = nup+fill_in
do k=1,nz
call psb_heap_get_first(witem,widx,heap,info)
call heap%get_first(witem,widx,info)
xw(k) = witem
xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true.