Reworked ensure_size

master
sfilippone 2 years ago
parent 98945f36b5
commit 677789469c

@ -123,7 +123,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -236,9 +236,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_ipk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -123,7 +123,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -236,9 +236,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_ipk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -124,7 +124,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -237,9 +237,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_ipk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -124,7 +124,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_lpk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -237,9 +237,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_lpk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_lpk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -123,7 +123,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -236,9 +236,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_ipk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

@ -123,7 +123,7 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5
@ -236,9 +236,9 @@ contains
return return
endif endif
call psb_ensure_size(heap%last+1,heap%keys,info,addsz=(1_psb_ipk_)*psb_heap_resize) call psb_ensure_size(heap%last+1,heap%keys,info)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_ensure_size(heap%last+1,heap%idxs,info,addsz=(1_psb_ipk_)*psb_heap_resize) & call psb_ensure_size(heap%last+1,heap%idxs,info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(psb_err_unit,*) 'Memory allocation failure in heap_insert' write(psb_err_unit,*) 'Memory allocation failure in heap_insert'
info = -5 info = -5

@ -1009,18 +1009,17 @@ Contains
!!$ goto 9999 !!$ goto 9999
!!$ End If !!$ End If
!!$ end If !!$ end If
If (len > psb_size(v)) Then isz = psb_size(v)
If (len > isz) Then
#if defined(OPENMP) #if defined(OPENMP)
!$OMP CRITICAL !$OMP CRITICAL
if (len > psb_size(v)) then if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz))
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
@ -1033,17 +1032,18 @@ Contains
goto 9999 goto 9999
end if end if
#else #else
if (len > isz) then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else else if (present(addsz)) then
if (present(addsz)) then isz = max(len,1,isz+addsz)
isz = len+max(1,addsz)
else else
isz = max(len+10, int(1.25*len)) isz = max(len,1,int(1.25*isz))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)
end if
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_realloc') call psb_errpush(info,name,a_err='psb_realloc')
@ -1085,16 +1085,14 @@ Contains
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
goto 9999 goto 9999
end if end if
isz = psb_size(v)
If (len > psb_size(v)) Then If (len > isz) Then
if (present(newsz)) then if (present(newsz)) then
isz = (max(len+1,newsz)) isz = max(len+1,1,newsz)
else if (present(addsz)) then
isz = max(len,1,isz+addsz)
else else
if (present(addsz)) then isz = max(len,1,int(1.25*isz))
isz = len+max(1,addsz)
else
isz = max(len+10, int(1.25*len))
endif
endif endif
call psb_realloc(isz,v,info,pad=pad) call psb_realloc(isz,v,info,pad=pad)

Loading…
Cancel
Save