fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
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
stopcriterion
Salvatore Filippone 10 years ago
parent 47b2784049
commit cd6db8e3ed
8 changed files with 124 additions and 124 deletions
Show Stats Download Patch File Download Diff File

28
mlprec/impl/mld_ciluk_fact.f90
Unescape Escape View File

@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_spk_), allocatable :: row(:) complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ciluk_factint' character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output ! 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 ! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact. ! 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 ! The heap containing the column indices of the nonzero
! entries in the array row. ! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out) ! Note: this argument is intent(inout) and not only intent(out)
@ -492,11 +492,11 @@ contains
! Arguments ! Arguments
type(psb_cspmat_type), intent(in) :: a type(psb_cspmat_type), intent(in) :: a
type(psb_c_coo_sparse_mat), intent(inout) :: trw type(psb_c_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_spk_), intent(inout) :: row(:) complex(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap type(psb_i_heap), intent(inout) :: heap
! Local variables ! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz integer(psb_ipk_) :: k,j,irb,err_act,nz
@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return if (psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
select type (aa=> a%a) select type (aa=> a%a)
type is (psb_c_csr_sparse_mat) type is (psb_c_csr_sparse_mat)
@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j) row(k) = aa%val(j)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
end do end do
@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw) row(k) = trw%val(ktrw)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
ktrw = ktrw + 1 ktrw = ktrw + 1
enddo enddo
@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1) ! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination ! means that the k-th row entry is zero throughout the elimination
! step. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -642,7 +642,7 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
@ -667,7 +667,7 @@ contains
! !
do do
! Beware: (iret < 0) means that the heap is empty, not an error. ! 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 if (iret < 0) return
! !
@ -706,7 +706,7 @@ contains
! need to insert it more than once. ! need to insert it more than once.
! !
if (rowlevs(j)<0) then if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j)) rowlevs(j) = abs(rowlevs(j))
end if end if

34
mlprec/impl/mld_cilut_fact.f90
Unescape Escape View File

@ -307,7 +307,7 @@ contains
real(psb_spk_) :: weight real(psb_spk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:) integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_spk_), allocatable :: row(:) complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_c_coo_sparse_mat) :: trw type(psb_c_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_cilut_factint' character(len=20), parameter :: name='mld_cilut_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -517,7 +517,7 @@ contains
real(psb_spk_), intent(inout) :: nrmi real(psb_spk_), intent(inout) :: nrmi
complex(psb_spk_), intent(inout) :: row(:) complex(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight 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_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40 integer(psb_ipk_), parameter :: nrb=40
@ -529,7 +529,7 @@ contains
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -559,7 +559,7 @@ contains
k = aa%ja(j) k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw) k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the ! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e. ! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -702,10 +702,10 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info 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_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:) complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
@ -724,7 +724,7 @@ contains
! !
do do
call psb_heap_get_first(k,heap,iret) call heap%get_first(k,iret)
if (iret < 0) exit if (iret < 0) exit
! !
@ -772,7 +772,7 @@ contains
! !
! Do the insertion. ! Do the insertion.
! !
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
endif endif
end do end do
@ -903,7 +903,7 @@ contains
complex(psb_spk_) :: witem complex(psb_spk_) :: witem
integer(psb_ipk_) :: widx integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz 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), parameter :: name='ilut_copyout'
character(len=20) :: ch_err character(len=20) :: ch_err
logical :: fndmaxup logical :: fndmaxup
@ -921,7 +921,7 @@ contains
! is the largest absolute value. ! 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_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -953,7 +953,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -971,7 +971,7 @@ contains
else else
nz = nlw+fill_in nz = nlw+fill_in
do k=1,nz 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first') call psb_errpush(info,name,a_err='psb_heap_get_first')
@ -1058,7 +1058,7 @@ contains
! Now the upper part ! 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -1090,7 +1090,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -1112,7 +1112,7 @@ contains
fndmaxup = .false. fndmaxup = .false.
nz = nup+fill_in nz = nup+fill_in
do k=1,nz do k=1,nz
call psb_heap_get_first(witem,widx,heap,info) call heap%get_first(witem,widx,info)
xw(k) = witem xw(k) = witem
xwid(k) = widx xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true. if (widx == jmaxup) fndmaxup=.true.

28
mlprec/impl/mld_diluk_fact.f90
Unescape Escape View File

@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_dpk_), allocatable :: row(:) real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_diluk_factint' character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output ! 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 ! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact. ! 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 ! The heap containing the column indices of the nonzero
! entries in the array row. ! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out) ! Note: this argument is intent(inout) and not only intent(out)
@ -492,11 +492,11 @@ contains
! Arguments ! Arguments
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: trw type(psb_d_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_dpk_), intent(inout) :: row(:) real(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap type(psb_i_heap), intent(inout) :: heap
! Local variables ! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz integer(psb_ipk_) :: k,j,irb,err_act,nz
@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return if (psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
select type (aa=> a%a) select type (aa=> a%a)
type is (psb_d_csr_sparse_mat) type is (psb_d_csr_sparse_mat)
@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j) row(k) = aa%val(j)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
end do end do
@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw) row(k) = trw%val(ktrw)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
ktrw = ktrw + 1 ktrw = ktrw + 1
enddo enddo
@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1) ! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination ! means that the k-th row entry is zero throughout the elimination
! step. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -642,7 +642,7 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
@ -667,7 +667,7 @@ contains
! !
do do
! Beware: (iret < 0) means that the heap is empty, not an error. ! 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 if (iret < 0) return
! !
@ -706,7 +706,7 @@ contains
! need to insert it more than once. ! need to insert it more than once.
! !
if (rowlevs(j)<0) then if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j)) rowlevs(j) = abs(rowlevs(j))
end if end if

34
mlprec/impl/mld_dilut_fact.f90
Unescape Escape View File

@ -307,7 +307,7 @@ contains
real(psb_dpk_) :: weight real(psb_dpk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:) integer(psb_ipk_), allocatable :: idxs(:)
real(psb_dpk_), allocatable :: row(:) real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_d_coo_sparse_mat) :: trw type(psb_d_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_dilut_factint' character(len=20), parameter :: name='mld_dilut_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -517,7 +517,7 @@ contains
real(psb_dpk_), intent(inout) :: nrmi real(psb_dpk_), intent(inout) :: nrmi
real(psb_dpk_), intent(inout) :: row(:) real(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight 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_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40 integer(psb_ipk_), parameter :: nrb=40
@ -529,7 +529,7 @@ contains
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -559,7 +559,7 @@ contains
k = aa%ja(j) k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw) k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the ! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e. ! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -702,10 +702,10 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info 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_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
@ -724,7 +724,7 @@ contains
! !
do do
call psb_heap_get_first(k,heap,iret) call heap%get_first(k,iret)
if (iret < 0) exit if (iret < 0) exit
! !
@ -772,7 +772,7 @@ contains
! !
! Do the insertion. ! Do the insertion.
! !
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
endif endif
end do end do
@ -903,7 +903,7 @@ contains
real(psb_dpk_) :: witem real(psb_dpk_) :: witem
integer(psb_ipk_) :: widx integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz 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), parameter :: name='ilut_copyout'
character(len=20) :: ch_err character(len=20) :: ch_err
logical :: fndmaxup logical :: fndmaxup
@ -921,7 +921,7 @@ contains
! is the largest absolute value. ! 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_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -953,7 +953,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -971,7 +971,7 @@ contains
else else
nz = nlw+fill_in nz = nlw+fill_in
do k=1,nz 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first') call psb_errpush(info,name,a_err='psb_heap_get_first')
@ -1058,7 +1058,7 @@ contains
! Now the upper part ! 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -1090,7 +1090,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -1112,7 +1112,7 @@ contains
fndmaxup = .false. fndmaxup = .false.
nz = nup+fill_in nz = nup+fill_in
do k=1,nz do k=1,nz
call psb_heap_get_first(witem,widx,heap,info) call heap%get_first(witem,widx,info)
xw(k) = witem xw(k) = witem
xwid(k) = widx xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true. if (widx == jmaxup) fndmaxup=.true.

28
mlprec/impl/mld_siluk_fact.f90
Unescape Escape View File

@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
real(psb_spk_), allocatable :: row(:) real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_siluk_factint' character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output ! 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 ! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact. ! 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 ! The heap containing the column indices of the nonzero
! entries in the array row. ! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out) ! Note: this argument is intent(inout) and not only intent(out)
@ -492,11 +492,11 @@ contains
! Arguments ! Arguments
type(psb_sspmat_type), intent(in) :: a type(psb_sspmat_type), intent(in) :: a
type(psb_s_coo_sparse_mat), intent(inout) :: trw type(psb_s_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
real(psb_spk_), intent(inout) :: row(:) real(psb_spk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap type(psb_i_heap), intent(inout) :: heap
! Local variables ! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz integer(psb_ipk_) :: k,j,irb,err_act,nz
@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return if (psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
select type (aa=> a%a) select type (aa=> a%a)
type is (psb_s_csr_sparse_mat) type is (psb_s_csr_sparse_mat)
@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j) row(k) = aa%val(j)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
end do end do
@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw) row(k) = trw%val(ktrw)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
ktrw = ktrw + 1 ktrw = ktrw + 1
enddo enddo
@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1) ! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination ! means that the k-th row entry is zero throughout the elimination
! step. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -642,7 +642,7 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
@ -667,7 +667,7 @@ contains
! !
do do
! Beware: (iret < 0) means that the heap is empty, not an error. ! 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 if (iret < 0) return
! !
@ -706,7 +706,7 @@ contains
! need to insert it more than once. ! need to insert it more than once.
! !
if (rowlevs(j)<0) then if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j)) rowlevs(j) = abs(rowlevs(j))
end if end if

34
mlprec/impl/mld_silut_fact.f90
Unescape Escape View File

@ -307,7 +307,7 @@ contains
real(psb_spk_) :: weight real(psb_spk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:) integer(psb_ipk_), allocatable :: idxs(:)
real(psb_spk_), allocatable :: row(:) real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_s_coo_sparse_mat) :: trw type(psb_s_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_silut_factint' character(len=20), parameter :: name='mld_silut_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -517,7 +517,7 @@ contains
real(psb_spk_), intent(inout) :: nrmi real(psb_spk_), intent(inout) :: nrmi
real(psb_spk_), intent(inout) :: row(:) real(psb_spk_), intent(inout) :: row(:)
real(psb_spk_), intent(in) :: weight 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_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40 integer(psb_ipk_), parameter :: nrb=40
@ -529,7 +529,7 @@ contains
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -559,7 +559,7 @@ contains
k = aa%ja(j) k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw) k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the ! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e. ! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -702,10 +702,10 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info 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_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:) real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
@ -724,7 +724,7 @@ contains
! !
do do
call psb_heap_get_first(k,heap,iret) call heap%get_first(k,iret)
if (iret < 0) exit if (iret < 0) exit
! !
@ -772,7 +772,7 @@ contains
! !
! Do the insertion. ! Do the insertion.
! !
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
endif endif
end do end do
@ -903,7 +903,7 @@ contains
real(psb_spk_) :: witem real(psb_spk_) :: witem
integer(psb_ipk_) :: widx integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz 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), parameter :: name='ilut_copyout'
character(len=20) :: ch_err character(len=20) :: ch_err
logical :: fndmaxup logical :: fndmaxup
@ -921,7 +921,7 @@ contains
! is the largest absolute value. ! 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_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -953,7 +953,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -971,7 +971,7 @@ contains
else else
nz = nlw+fill_in nz = nlw+fill_in
do k=1,nz 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first') call psb_errpush(info,name,a_err='psb_heap_get_first')
@ -1058,7 +1058,7 @@ contains
! Now the upper part ! 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -1090,7 +1090,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -1112,7 +1112,7 @@ contains
fndmaxup = .false. fndmaxup = .false.
nz = nup+fill_in nz = nup+fill_in
do k=1,nz do k=1,nz
call psb_heap_get_first(witem,widx,heap,info) call heap%get_first(witem,widx,info)
xw(k) = witem xw(k) = witem
xwid(k) = widx xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true. if (widx == jmaxup) fndmaxup=.true.

28
mlprec/impl/mld_ziluk_fact.f90
Unescape Escape View File

@ -285,8 +285,8 @@ contains
integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m
integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:)
complex(psb_dpk_), allocatable :: row(:) complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_ziluk_factint' character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -466,7 +466,7 @@ contains
! In input rowlevs(k) = -(m+1) for k=1,...,m. In output ! 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 ! rowlevs(k) = 0 for 1 <= k <= jmax and A(i,k) /= 0, for
! future use in iluk_fact. ! 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 ! The heap containing the column indices of the nonzero
! entries in the array row. ! entries in the array row.
! Note: this argument is intent(inout) and not only intent(out) ! Note: this argument is intent(inout) and not only intent(out)
@ -492,11 +492,11 @@ contains
! Arguments ! Arguments
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_z_coo_sparse_mat), intent(inout) :: trw type(psb_z_coo_sparse_mat), intent(inout) :: trw
integer(psb_ipk_), intent(in) :: i,m,jmin,jmax integer(psb_ipk_), intent(in) :: i,m,jmin,jmax
integer(psb_ipk_), intent(inout) :: ktrw,info integer(psb_ipk_), intent(inout) :: ktrw,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
complex(psb_dpk_), intent(inout) :: row(:) complex(psb_dpk_), intent(inout) :: row(:)
type(psb_int_heap), intent(inout) :: heap type(psb_i_heap), intent(inout) :: heap
! Local variables ! Local variables
integer(psb_ipk_) :: k,j,irb,err_act,nz integer(psb_ipk_) :: k,j,irb,err_act,nz
@ -507,7 +507,7 @@ contains
if (psb_get_errstatus() /= 0) return if (psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
select type (aa=> a%a) select type (aa=> a%a)
type is (psb_z_csr_sparse_mat) type is (psb_z_csr_sparse_mat)
@ -520,7 +520,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j) row(k) = aa%val(j)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
end do end do
@ -553,7 +553,7 @@ contains
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw) row(k) = trw%val(ktrw)
rowlevs(k) = 0 rowlevs(k) = 0
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
end if end if
ktrw = ktrw + 1 ktrw = ktrw + 1
enddo enddo
@ -600,7 +600,7 @@ contains
! the row after the current elimination step; rowlevs(k) = -(m+1) ! the row after the current elimination step; rowlevs(k) = -(m+1)
! means that the k-th row entry is zero throughout the elimination ! means that the k-th row entry is zero throughout the elimination
! step. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -642,7 +642,7 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i, fill_in
integer(psb_ipk_), intent(inout) :: nidx,info integer(psb_ipk_), intent(inout) :: nidx,info
integer(psb_ipk_), intent(inout) :: rowlevs(:) integer(psb_ipk_), intent(inout) :: rowlevs(:)
@ -667,7 +667,7 @@ contains
! !
do do
! Beware: (iret < 0) means that the heap is empty, not an error. ! 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 if (iret < 0) return
! !
@ -706,7 +706,7 @@ contains
! need to insert it more than once. ! need to insert it more than once.
! !
if (rowlevs(j)<0) then if (rowlevs(j)<0) then
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
rowlevs(j) = abs(rowlevs(j)) rowlevs(j) = abs(rowlevs(j))
end if end if

34
mlprec/impl/mld_zilut_fact.f90
Unescape Escape View File

@ -307,7 +307,7 @@ contains
real(psb_dpk_) :: weight real(psb_dpk_) :: weight
integer(psb_ipk_), allocatable :: idxs(:) integer(psb_ipk_), allocatable :: idxs(:)
complex(psb_dpk_), allocatable :: row(:) complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap type(psb_i_heap) :: heap
type(psb_z_coo_sparse_mat) :: trw type(psb_z_coo_sparse_mat) :: trw
character(len=20), parameter :: name='mld_zilut_factint' character(len=20), parameter :: name='mld_zilut_factint'
character(len=20) :: ch_err character(len=20) :: ch_err
@ -517,7 +517,7 @@ contains
real(psb_dpk_), intent(inout) :: nrmi real(psb_dpk_), intent(inout) :: nrmi
complex(psb_dpk_), intent(inout) :: row(:) complex(psb_dpk_), intent(inout) :: row(:)
real(psb_dpk_), intent(in) :: weight 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_) :: k,j,irb,kin,nz
integer(psb_ipk_), parameter :: nrb=40 integer(psb_ipk_), parameter :: nrb=40
@ -529,7 +529,7 @@ contains
info = psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
call psb_init_heap(heap,info) call heap%init(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -559,7 +559,7 @@ contains
k = aa%ja(j) k = aa%ja(j)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = aa%val(j)*weight row(k) = aa%val(j)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -610,7 +610,7 @@ contains
k = trw%ja(ktrw) k = trw%ja(ktrw)
if ((jmin<=k).and.(k<=jmax)) then if ((jmin<=k).and.(k<=jmax)) then
row(k) = trw%val(ktrw)*weight row(k) = trw%val(ktrw)*weight
call psb_insert_heap(k,heap,info) call heap%insert(k,info)
if (info /= psb_success_) exit if (info /= psb_success_) exit
if (k<jd) nlw = nlw + 1 if (k<jd) nlw = nlw + 1
if (k>jd) then if (k>jd) then
@ -662,7 +662,7 @@ contains
! has to be applied. In output it contains the row after the ! has to be applied. In output it contains the row after the
! elimination step. It actually contains a full row, i.e. ! elimination step. It actually contains a full row, i.e.
! it contains also the zero entries of the row. ! 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 ! The heap containing the column indices of the nonzero entries
! in the processed row. In input it contains the indices concerning ! in the processed row. In input it contains the indices concerning
! the row before the elimination step, while in output it contains ! the row before the elimination step, while in output it contains
@ -702,10 +702,10 @@ contains
implicit none implicit none
! Arguments ! 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(in) :: i
integer(psb_ipk_), intent(inout) :: nidx,info 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_), allocatable, intent(inout) :: idxs(:)
integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) integer(psb_ipk_), intent(inout) :: uja(:),uirp(:)
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
@ -724,7 +724,7 @@ contains
! !
do do
call psb_heap_get_first(k,heap,iret) call heap%get_first(k,iret)
if (iret < 0) exit if (iret < 0) exit
! !
@ -772,7 +772,7 @@ contains
! !
! Do the insertion. ! Do the insertion.
! !
call psb_insert_heap(j,heap,info) call heap%insert(j,info)
if (info /= psb_success_) return if (info /= psb_success_) return
endif endif
end do end do
@ -903,7 +903,7 @@ contains
complex(psb_dpk_) :: witem complex(psb_dpk_) :: witem
integer(psb_ipk_) :: widx integer(psb_ipk_) :: widx
integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz 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), parameter :: name='ilut_copyout'
character(len=20) :: ch_err character(len=20) :: ch_err
logical :: fndmaxup logical :: fndmaxup
@ -921,7 +921,7 @@ contains
! is the largest absolute value. ! 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_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -953,7 +953,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -971,7 +971,7 @@ contains
else else
nz = nlw+fill_in nz = nlw+fill_in
do k=1,nz 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_heap_get_first') call psb_errpush(info,name,a_err='psb_heap_get_first')
@ -1058,7 +1058,7 @@ contains
! Now the upper part ! 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 if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_init_heap') call psb_errpush(info,name,a_err='psb_init_heap')
@ -1090,7 +1090,7 @@ contains
nz = nz + 1 nz = nz + 1
xw(nz) = witem xw(nz) = witem
xwid(nz) = widx xwid(nz) = widx
call psb_insert_heap(witem,widx,heap,info) call heap%insert(witem,widx,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_insert_heap') call psb_errpush(info,name,a_err='psb_insert_heap')
@ -1112,7 +1112,7 @@ contains
fndmaxup = .false. fndmaxup = .false.
nz = nup+fill_in nz = nup+fill_in
do k=1,nz do k=1,nz
call psb_heap_get_first(witem,widx,heap,info) call heap%get_first(witem,widx,info)
xw(k) = witem xw(k) = witem
xwid(k) = widx xwid(k) = widx
if (widx == jmaxup) fndmaxup=.true. if (widx == jmaxup) fndmaxup=.true.

Write Preview
Loading…
Cancel
Save