fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

Improve handling of heap size and calls to realloc & friends

Browse Source
This commit is contained in:
sfilippone
2026-07-27 09:48:08 +02:00
parent 850e0d1cc1
commit 2c49a200af
23 changed files with 401 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/auxil/psb_c_hsort_x_mod.f90
+47 -7
View File
@@ -43,10 +43,12 @@
module psb_c_hsort_x_mod
use psb_const_mod
use psb_c_hsort_mod
use psb_realloc_mod
type psb_c_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
complex(psb_spk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_c_init_heap
@@ -55,11 +57,14 @@ module psb_c_hsort_x_mod
procedure, pass(heap) :: get_first => psb_c_heap_get_first
procedure, pass(heap) :: dump => psb_c_dump_heap
procedure, pass(heap) :: free => psb_c_free_heap
procedure, pass(heap) :: get_size => psb_c_heap_get_size
procedure, pass(heap) :: set_size => psb_c_heap_set_size
end type psb_c_heap
type psb_c_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
complex(psb_spk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -69,13 +74,26 @@ module psb_c_hsort_x_mod
procedure, pass(heap) :: get_first => psb_c_idx_heap_get_first
procedure, pass(heap) :: dump => psb_c_idx_dump_heap
procedure, pass(heap) :: free => psb_c_idx_free_heap
procedure, pass(heap) :: get_size => psb_c_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_c_idx_heap_set_size
end type psb_c_idx_heap
contains
subroutine psb_c_heap_set_size(heap,size)
class(psb_c_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_c_heap_set_size
function psb_c_heap_get_size(heap) result(size)
class(psb_c_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_c_heap_get_size
subroutine psb_c_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_c_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -96,7 +114,7 @@ contains
heap%dir = psb_asort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_c_init_heap
@@ -123,7 +141,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -182,9 +203,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_c_free_heap
subroutine psb_c_idx_heap_set_size(heap,size)
class(psb_c_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_c_idx_heap_set_size
function psb_c_idx_heap_get_size(heap) result(size)
class(psb_c_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_c_idx_heap_get_size
subroutine psb_c_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -209,6 +244,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_c_idx_init_heap
@@ -236,9 +272,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -304,7 +343,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_c_idx_free_heap
end module psb_c_hsort_x_mod
base/modules/auxil/psb_d_hsort_x_mod.f90
+47 -7
View File
@@ -43,10 +43,12 @@
module psb_d_hsort_x_mod
use psb_const_mod
use psb_d_hsort_mod
use psb_realloc_mod
type psb_d_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
real(psb_dpk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_d_init_heap
@@ -55,11 +57,14 @@ module psb_d_hsort_x_mod
procedure, pass(heap) :: get_first => psb_d_heap_get_first
procedure, pass(heap) :: dump => psb_d_dump_heap
procedure, pass(heap) :: free => psb_d_free_heap
procedure, pass(heap) :: get_size => psb_d_heap_get_size
procedure, pass(heap) :: set_size => psb_d_heap_set_size
end type psb_d_heap
type psb_d_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
real(psb_dpk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -69,13 +74,26 @@ module psb_d_hsort_x_mod
procedure, pass(heap) :: get_first => psb_d_idx_heap_get_first
procedure, pass(heap) :: dump => psb_d_idx_dump_heap
procedure, pass(heap) :: free => psb_d_idx_free_heap
procedure, pass(heap) :: get_size => psb_d_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_d_idx_heap_set_size
end type psb_d_idx_heap
contains
subroutine psb_d_heap_set_size(heap,size)
class(psb_d_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_d_heap_set_size
function psb_d_heap_get_size(heap) result(size)
class(psb_d_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_d_heap_get_size
subroutine psb_d_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_d_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -96,7 +114,7 @@ contains
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_d_init_heap
@@ -123,7 +141,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -182,9 +203,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_d_free_heap
subroutine psb_d_idx_heap_set_size(heap,size)
class(psb_d_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_d_idx_heap_set_size
function psb_d_idx_heap_get_size(heap) result(size)
class(psb_d_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_d_idx_heap_get_size
subroutine psb_d_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -209,6 +244,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_d_idx_init_heap
@@ -236,9 +272,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -304,7 +343,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_d_idx_free_heap
end module psb_d_hsort_x_mod
base/modules/auxil/psb_i2_hsort_x_mod.f90
+47 -7
View File
@@ -45,10 +45,12 @@ module psb_i2_hsort_x_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
use psb_realloc_mod
type psb_i2_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
integer(psb_i2pk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_i2_init_heap
@@ -57,11 +59,14 @@ module psb_i2_hsort_x_mod
procedure, pass(heap) :: get_first => psb_i2_heap_get_first
procedure, pass(heap) :: dump => psb_i2_dump_heap
procedure, pass(heap) :: free => psb_i2_free_heap
procedure, pass(heap) :: get_size => psb_i2_heap_get_size
procedure, pass(heap) :: set_size => psb_i2_heap_set_size
end type psb_i2_heap
type psb_i2_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
integer(psb_i2pk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -71,13 +76,26 @@ module psb_i2_hsort_x_mod
procedure, pass(heap) :: get_first => psb_i2_idx_heap_get_first
procedure, pass(heap) :: dump => psb_i2_idx_dump_heap
procedure, pass(heap) :: free => psb_i2_idx_free_heap
procedure, pass(heap) :: get_size => psb_i2_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_i2_idx_heap_set_size
end type psb_i2_idx_heap
contains
subroutine psb_i2_heap_set_size(heap,size)
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_i2_heap_set_size
function psb_i2_heap_get_size(heap) result(size)
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_i2_heap_get_size
subroutine psb_i2_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_i2_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -98,7 +116,7 @@ contains
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_i2_init_heap
@@ -125,7 +143,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -184,9 +205,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_i2_free_heap
subroutine psb_i2_idx_heap_set_size(heap,size)
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_i2_idx_heap_set_size
function psb_i2_idx_heap_get_size(heap) result(size)
class(psb_i2_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_i2_idx_heap_get_size
subroutine psb_i2_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -211,6 +246,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_i2_idx_init_heap
@@ -238,9 +274,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -306,7 +345,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_i2_idx_free_heap
end module psb_i2_hsort_x_mod
base/modules/auxil/psb_i_hsort_x_mod.f90
+47 -7
View File
@@ -45,10 +45,12 @@ module psb_i_hsort_x_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
use psb_realloc_mod
type psb_i_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
integer(psb_ipk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_i_init_heap
@@ -57,11 +59,14 @@ module psb_i_hsort_x_mod
procedure, pass(heap) :: get_first => psb_i_heap_get_first
procedure, pass(heap) :: dump => psb_i_dump_heap
procedure, pass(heap) :: free => psb_i_free_heap
procedure, pass(heap) :: get_size => psb_i_heap_get_size
procedure, pass(heap) :: set_size => psb_i_heap_set_size
end type psb_i_heap
type psb_i_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
integer(psb_ipk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -71,13 +76,26 @@ module psb_i_hsort_x_mod
procedure, pass(heap) :: get_first => psb_i_idx_heap_get_first
procedure, pass(heap) :: dump => psb_i_idx_dump_heap
procedure, pass(heap) :: free => psb_i_idx_free_heap
procedure, pass(heap) :: get_size => psb_i_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_i_idx_heap_set_size
end type psb_i_idx_heap
contains
subroutine psb_i_heap_set_size(heap,size)
class(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_i_heap_set_size
function psb_i_heap_get_size(heap) result(size)
class(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_i_heap_get_size
subroutine psb_i_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_i_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -98,7 +116,7 @@ contains
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_i_init_heap
@@ -125,7 +143,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -184,9 +205,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_i_free_heap
subroutine psb_i_idx_heap_set_size(heap,size)
class(psb_i_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_i_idx_heap_set_size
function psb_i_idx_heap_get_size(heap) result(size)
class(psb_i_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_i_idx_heap_get_size
subroutine psb_i_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -211,6 +246,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_i_idx_init_heap
@@ -238,9 +274,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -306,7 +345,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_i_idx_free_heap
end module psb_i_hsort_x_mod
base/modules/auxil/psb_l_hsort_x_mod.f90
+47 -7
View File
@@ -45,10 +45,12 @@ module psb_l_hsort_x_mod
use psb_e_hsort_mod
use psb_m_hsort_mod
use psb_i2_hsort_mod
use psb_realloc_mod
type psb_l_heap
integer(psb_lpk_) :: dir
integer(psb_lpk_) :: last
integer(psb_ipk_) :: size
integer(psb_lpk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_l_init_heap
@@ -57,11 +59,14 @@ module psb_l_hsort_x_mod
procedure, pass(heap) :: get_first => psb_l_heap_get_first
procedure, pass(heap) :: dump => psb_l_dump_heap
procedure, pass(heap) :: free => psb_l_free_heap
procedure, pass(heap) :: get_size => psb_l_heap_get_size
procedure, pass(heap) :: set_size => psb_l_heap_set_size
end type psb_l_heap
type psb_l_idx_heap
integer(psb_lpk_) :: dir
integer(psb_lpk_) :: last
integer(psb_ipk_) :: size
integer(psb_lpk_), allocatable :: keys(:)
integer(psb_lpk_), allocatable :: idxs(:)
contains
@@ -71,13 +76,26 @@ module psb_l_hsort_x_mod
procedure, pass(heap) :: get_first => psb_l_idx_heap_get_first
procedure, pass(heap) :: dump => psb_l_idx_dump_heap
procedure, pass(heap) :: free => psb_l_idx_free_heap
procedure, pass(heap) :: get_size => psb_l_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_l_idx_heap_set_size
end type psb_l_idx_heap
contains
subroutine psb_l_heap_set_size(heap,size)
class(psb_l_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_l_heap_set_size
function psb_l_heap_get_size(heap) result(size)
class(psb_l_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_l_heap_get_size
subroutine psb_l_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_l_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -98,7 +116,7 @@ contains
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_l_init_heap
@@ -125,7 +143,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -184,9 +205,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_l_free_heap
subroutine psb_l_idx_heap_set_size(heap,size)
class(psb_l_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_l_idx_heap_set_size
function psb_l_idx_heap_get_size(heap) result(size)
class(psb_l_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_l_idx_heap_get_size
subroutine psb_l_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -211,6 +246,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_l_idx_init_heap
@@ -238,9 +274,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -306,7 +345,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_l_idx_free_heap
end module psb_l_hsort_x_mod
base/modules/auxil/psb_s_hsort_x_mod.f90
+47 -7
View File
@@ -43,10 +43,12 @@
module psb_s_hsort_x_mod
use psb_const_mod
use psb_s_hsort_mod
use psb_realloc_mod
type psb_s_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
real(psb_spk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_s_init_heap
@@ -55,11 +57,14 @@ module psb_s_hsort_x_mod
procedure, pass(heap) :: get_first => psb_s_heap_get_first
procedure, pass(heap) :: dump => psb_s_dump_heap
procedure, pass(heap) :: free => psb_s_free_heap
procedure, pass(heap) :: get_size => psb_s_heap_get_size
procedure, pass(heap) :: set_size => psb_s_heap_set_size
end type psb_s_heap
type psb_s_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
real(psb_spk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -69,13 +74,26 @@ module psb_s_hsort_x_mod
procedure, pass(heap) :: get_first => psb_s_idx_heap_get_first
procedure, pass(heap) :: dump => psb_s_idx_dump_heap
procedure, pass(heap) :: free => psb_s_idx_free_heap
procedure, pass(heap) :: get_size => psb_s_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_s_idx_heap_set_size
end type psb_s_idx_heap
contains
subroutine psb_s_heap_set_size(heap,size)
class(psb_s_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_s_heap_set_size
function psb_s_heap_get_size(heap) result(size)
class(psb_s_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_s_heap_get_size
subroutine psb_s_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_s_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -96,7 +114,7 @@ contains
heap%dir = psb_sort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_s_init_heap
@@ -123,7 +141,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -182,9 +203,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_s_free_heap
subroutine psb_s_idx_heap_set_size(heap,size)
class(psb_s_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_s_idx_heap_set_size
function psb_s_idx_heap_get_size(heap) result(size)
class(psb_s_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_s_idx_heap_get_size
subroutine psb_s_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -209,6 +244,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_s_idx_init_heap
@@ -236,9 +272,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -304,7 +343,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_s_idx_free_heap
end module psb_s_hsort_x_mod
base/modules/auxil/psb_z_hsort_x_mod.f90
+47 -7
View File
@@ -43,10 +43,12 @@
module psb_z_hsort_x_mod
use psb_const_mod
use psb_z_hsort_mod
use psb_realloc_mod
type psb_z_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
complex(psb_dpk_), allocatable :: keys(:)
contains
procedure, pass(heap) :: init => psb_z_init_heap
@@ -55,11 +57,14 @@ module psb_z_hsort_x_mod
procedure, pass(heap) :: get_first => psb_z_heap_get_first
procedure, pass(heap) :: dump => psb_z_dump_heap
procedure, pass(heap) :: free => psb_z_free_heap
procedure, pass(heap) :: get_size => psb_z_heap_get_size
procedure, pass(heap) :: set_size => psb_z_heap_set_size
end type psb_z_heap
type psb_z_idx_heap
integer(psb_ipk_) :: dir
integer(psb_ipk_) :: last
integer(psb_ipk_) :: size
complex(psb_dpk_), allocatable :: keys(:)
integer(psb_ipk_), allocatable :: idxs(:)
contains
@@ -69,13 +74,26 @@ module psb_z_hsort_x_mod
procedure, pass(heap) :: get_first => psb_z_idx_heap_get_first
procedure, pass(heap) :: dump => psb_z_idx_dump_heap
procedure, pass(heap) :: free => psb_z_idx_free_heap
procedure, pass(heap) :: get_size => psb_z_idx_heap_get_size
procedure, pass(heap) :: set_size => psb_z_idx_heap_set_size
end type psb_z_idx_heap
contains
subroutine psb_z_heap_set_size(heap,size)
class(psb_z_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_z_heap_set_size
function psb_z_heap_get_size(heap) result(size)
class(psb_z_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_z_heap_get_size
subroutine psb_z_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
class(psb_z_heap), intent(inout) :: heap
integer(psb_ipk_), intent(out) :: info
@@ -96,7 +114,7 @@ contains
heap%dir = psb_asort_up_
end select
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_z_init_heap
@@ -123,7 +141,10 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -182,9 +203,23 @@ contains
info=psb_success_
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_z_free_heap
subroutine psb_z_idx_heap_set_size(heap,size)
class(psb_z_idx_heap), intent(inout) :: heap
integer(psb_ipk_), intent(in) :: size
heap%size = size
end subroutine psb_z_idx_heap_set_size
function psb_z_idx_heap_get_size(heap) result(size)
class(psb_z_idx_heap), intent(inout) :: heap
integer(psb_ipk_) :: size
size = heap%size
end function psb_z_idx_heap_get_size
subroutine psb_z_idx_init_heap(heap,info,dir)
use psb_realloc_mod, only : psb_ensure_size
implicit none
@@ -209,6 +244,7 @@ contains
call psb_ensure_size(psb_heap_resize,heap%keys,info)
call psb_ensure_size(psb_heap_resize,heap%idxs,info)
call heap%set_size(psb_heap_resize)
return
end subroutine psb_z_idx_init_heap
@@ -236,9 +272,12 @@ contains
return
endif
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
if ((heap%last+1) > heap%size) then
call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info)
heap%size = size(heap%keys)
end if
if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5
@@ -304,7 +343,8 @@ contains
if (allocated(heap%keys)) deallocate(heap%keys,stat=info)
if ((info == psb_success_).and.(allocated(heap%idxs))) &
& deallocate(heap%idxs,stat=info)
heap%last = -1
call heap%set_size(-1)
end subroutine psb_z_idx_free_heap
end module psb_z_hsort_x_mod
prec/impl/psb_c_iluk_fact.f90
+2 -2
View File
@@ -900,7 +900,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -942,7 +942,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info == psb_success_) call psb_realloc(isz,uplevs,info,pad=(m+1))
prec/impl/psb_c_ilut_fact.f90
+8 -5
View File
@@ -757,7 +757,7 @@ contains
complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
complex(psb_spk_) :: rwk
info = psb_success_
@@ -829,8 +829,11 @@ contains
! If we get here it is an index we need to keep on copyout.
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
end do
@@ -1045,7 +1048,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -1191,7 +1194,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info /= psb_success_) then
prec/impl/psb_c_invk_fact.f90
+1 -3
View File
@@ -372,7 +372,7 @@ subroutine psb_c_invk_copyout(fill_in,i,m,row,rowlevs,nidx,idxs,&
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,uaspk,info)
if (info == psb_success_) call psb_realloc(isz,uia1,info)
if (info /= psb_success_) then
@@ -426,8 +426,6 @@ subroutine psb_cinvk_inv(fill_in,i,row,rowlevs,heap,ja,irp,val,uplevs,&
info = psb_success_
call psb_ensure_size(200, idxs, info)
if (info /= psb_success_) return
nidx = 1
idxs(1) = i
lastk = i
prec/impl/psb_c_invt_fact.f90
+7 -4
View File
@@ -602,7 +602,7 @@ subroutine psb_c_invt_copyout(fill_in,thres,i,m,nlw,nup,jmaxup,nrmi,row, &
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,val,info)
if (info == psb_success_) call psb_realloc(isz,ja,info)
if (info /= psb_success_) then
@@ -650,7 +650,7 @@ subroutine psb_c_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
complex(psb_spk_), intent(inout) :: row(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_dpk_) :: rwk, alpha
info = psb_success_
@@ -729,8 +729,11 @@ subroutine psb_c_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
irwt(k) = 0
end do
prec/impl/psb_d_iluk_fact.f90
+2 -2
View File
@@ -900,7 +900,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -942,7 +942,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info == psb_success_) call psb_realloc(isz,uplevs,info,pad=(m+1))
prec/impl/psb_d_ilut_fact.f90
+8 -5
View File
@@ -757,7 +757,7 @@ contains
real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_dpk_) :: rwk
info = psb_success_
@@ -829,8 +829,11 @@ contains
! If we get here it is an index we need to keep on copyout.
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
end do
@@ -1045,7 +1048,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -1191,7 +1194,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info /= psb_success_) then
prec/impl/psb_d_invk_fact.f90
+1 -3
View File
@@ -372,7 +372,7 @@ subroutine psb_d_invk_copyout(fill_in,i,m,row,rowlevs,nidx,idxs,&
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,uaspk,info)
if (info == psb_success_) call psb_realloc(isz,uia1,info)
if (info /= psb_success_) then
@@ -426,8 +426,6 @@ subroutine psb_dinvk_inv(fill_in,i,row,rowlevs,heap,ja,irp,val,uplevs,&
info = psb_success_
call psb_ensure_size(200, idxs, info)
if (info /= psb_success_) return
nidx = 1
idxs(1) = i
lastk = i
prec/impl/psb_d_invt_fact.f90
+7 -4
View File
@@ -602,7 +602,7 @@ subroutine psb_d_invt_copyout(fill_in,thres,i,m,nlw,nup,jmaxup,nrmi,row, &
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,val,info)
if (info == psb_success_) call psb_realloc(isz,ja,info)
if (info /= psb_success_) then
@@ -650,7 +650,7 @@ subroutine psb_d_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
real(psb_dpk_), intent(inout) :: row(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_dpk_) :: rwk, alpha
info = psb_success_
@@ -729,8 +729,11 @@ subroutine psb_d_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
irwt(k) = 0
end do
prec/impl/psb_s_iluk_fact.f90
+2 -2
View File
@@ -900,7 +900,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -942,7 +942,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info == psb_success_) call psb_realloc(isz,uplevs,info,pad=(m+1))
prec/impl/psb_s_ilut_fact.f90
+8 -5
View File
@@ -757,7 +757,7 @@ contains
real(psb_spk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_spk_) :: rwk
info = psb_success_
@@ -829,8 +829,11 @@ contains
! If we get here it is an index we need to keep on copyout.
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
end do
@@ -1045,7 +1048,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -1191,7 +1194,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info /= psb_success_) then
prec/impl/psb_s_invk_fact.f90
+1 -3
View File
@@ -372,7 +372,7 @@ subroutine psb_s_invk_copyout(fill_in,i,m,row,rowlevs,nidx,idxs,&
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,uaspk,info)
if (info == psb_success_) call psb_realloc(isz,uia1,info)
if (info /= psb_success_) then
@@ -426,8 +426,6 @@ subroutine psb_sinvk_inv(fill_in,i,row,rowlevs,heap,ja,irp,val,uplevs,&
info = psb_success_
call psb_ensure_size(200, idxs, info)
if (info /= psb_success_) return
nidx = 1
idxs(1) = i
lastk = i
prec/impl/psb_s_invt_fact.f90
+7 -4
View File
@@ -602,7 +602,7 @@ subroutine psb_s_invt_copyout(fill_in,thres,i,m,nlw,nup,jmaxup,nrmi,row, &
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,val,info)
if (info == psb_success_) call psb_realloc(isz,ja,info)
if (info /= psb_success_) then
@@ -650,7 +650,7 @@ subroutine psb_s_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
real(psb_spk_), intent(inout) :: row(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_dpk_) :: rwk, alpha
info = psb_success_
@@ -729,8 +729,11 @@ subroutine psb_s_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
irwt(k) = 0
end do
prec/impl/psb_z_iluk_fact.f90
+2 -2
View File
@@ -900,7 +900,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -942,7 +942,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info == psb_success_) call psb_realloc(isz,uplevs,info,pad=(m+1))
prec/impl/psb_z_ilut_fact.f90
+8 -5
View File
@@ -757,7 +757,7 @@ contains
complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
complex(psb_dpk_) :: rwk
info = psb_success_
@@ -829,8 +829,11 @@ contains
! If we get here it is an index we need to keep on copyout.
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
end do
@@ -1045,7 +1048,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = (max((l1/i)*m,int(1.2*l1),l1+100))
isz = (max((l1/i)*m,int(1.5*l1),l1+100))
call psb_realloc(isz,lval,info)
if (info == psb_success_) call psb_realloc(isz,lja,info)
if (info /= psb_success_) then
@@ -1191,7 +1194,7 @@ contains
!
! Figure out a good reallocation size!
!
isz = max((l2/i)*m,int(1.2*l2),l2+100)
isz = max((l2/i)*m,int(1.5*l2),l2+100)
call psb_realloc(isz,uval,info)
if (info == psb_success_) call psb_realloc(isz,uja,info)
if (info /= psb_success_) then
prec/impl/psb_z_invk_fact.f90
+1 -3
View File
@@ -372,7 +372,7 @@ subroutine psb_z_invk_copyout(fill_in,i,m,row,rowlevs,nidx,idxs,&
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,uaspk,info)
if (info == psb_success_) call psb_realloc(isz,uia1,info)
if (info /= psb_success_) then
@@ -426,8 +426,6 @@ subroutine psb_zinvk_inv(fill_in,i,row,rowlevs,heap,ja,irp,val,uplevs,&
info = psb_success_
call psb_ensure_size(200, idxs, info)
if (info /= psb_success_) return
nidx = 1
idxs(1) = i
lastk = i
prec/impl/psb_z_invt_fact.f90
+7 -4
View File
@@ -602,7 +602,7 @@ subroutine psb_z_invt_copyout(fill_in,thres,i,m,nlw,nup,jmaxup,nrmi,row, &
!
! Figure out a good reallocation size!
!
isz = max(int(1.2*l2),l2+100)
isz = max(int(1.5*l2),l2+100)
call psb_realloc(isz,val,info)
if (info == psb_success_) call psb_realloc(isz,ja,info)
if (info /= psb_success_) then
@@ -650,7 +650,7 @@ subroutine psb_z_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
complex(psb_dpk_), intent(inout) :: row(:)
! Local Variables
integer(psb_ipk_) :: k,j,jj,lastk,iret
integer(psb_ipk_) :: k,j,jj,lastk,iret, isz
real(psb_dpk_) :: rwk, alpha
info = psb_success_
@@ -729,8 +729,11 @@ subroutine psb_z_invt_inv(thres,i,nrmi,row,heap,irwt,ja,irp,val,nidx,idxs,info)
!
nidx = nidx + 1
call psb_ensure_size(nidx,idxs,info,addsz=psb_heap_resize)
if (info /= psb_success_) return
if (nidx > size(idxs)) then
isz = max(nidx,int(1.5*size(idxs)))
call psb_ensure_size(isz,idxs,info)
if (info /= psb_success_) return
end if
idxs(nidx) = k
irwt(k) = 0
end do