fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 12:52:14 +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