Improve coo and merge development

master
sfilippone 2 years ago
parent 347352fe1e
commit a66778f270

@ -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

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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)

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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)

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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

@ -790,7 +790,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:) = vin(:) vout(:) = vin(:)
!$omp end workshare
endif endif
endif endif
@ -836,7 +838,9 @@ Contains
call psb_errpush(info,name,a_err=char_err) call psb_errpush(info,name,a_err=char_err)
goto 9999 goto 9999
else else
!$omp workshare
vout(:,:) = vin(:,:) vout(:,:) = vin(:,:)
!$omp end workshare
endif endif
endif endif
@ -1009,18 +1013,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 +1036,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 +1089,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)

@ -4563,7 +4563,7 @@ function psb_lc_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -4630,7 +4630,7 @@ function psb_lc_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -4680,7 +4680,7 @@ function psb_lc_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

@ -4563,7 +4563,7 @@ function psb_ld_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -4630,7 +4630,7 @@ function psb_ld_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -4680,7 +4680,7 @@ function psb_ld_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

@ -4563,7 +4563,7 @@ function psb_ls_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -4630,7 +4630,7 @@ function psb_ls_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -4680,7 +4680,7 @@ function psb_ls_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

@ -4563,7 +4563,7 @@ function psb_lz_coo_maxval(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, nnz do i=1, nnz
res = max(res,abs(a%val(i))) res = max(res,abs(a%val(i)))
end do end do
@ -4630,7 +4630,7 @@ function psb_lz_coo_csnmi(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, m do i=1, m
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do
@ -4680,7 +4680,7 @@ function psb_lz_coo_csnm1(a) result(res)
#if defined(OPENMP) #if defined(OPENMP)
block block
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
!$omp parallel do private(i) !$omp parallel do private(i) reduction(max:res)
do i=1, n do i=1, n
res = max(res,abs(vt(i))) res = max(res,abs(vt(i)))
end do end do

Loading…
Cancel
Save