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

psblas3:

Browse Source 
base/comm/internals/psi_cswapdata.F90
 base/comm/internals/psi_cswaptran.F90
 base/comm/internals/psi_dswapdata.F90
 base/comm/internals/psi_dswaptran.F90
 base/comm/internals/psi_iswapdata.F90
 base/comm/internals/psi_iswaptran.F90
 base/comm/internals/psi_sswapdata.F90
 base/comm/internals/psi_sswaptran.F90
 base/comm/internals/psi_zswapdata.F90
 base/comm/internals/psi_zswaptran.F90
 base/modules/psb_realloc_mod.F90
 base/modules/serial/psb_c_base_vect_mod.f90
 base/modules/serial/psb_d_base_vect_mod.f90
 base/modules/serial/psb_i_base_vect_mod.f90
 base/modules/serial/psb_s_base_vect_mod.f90
 base/modules/serial/psb_z_base_vect_mod.f90

Introduce v%maybe_free_buffer.
This commit is contained in:
Salvatore Filippone
2017-03-20 11:15:57 +00:00
parent 609d924505
commit 0329ffd968
16 changed files with 421 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/internals/psi_cswapdata.F90
+5 -5
View File
@@ -1320,8 +1320,8 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1668,9 +1668,9 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_cswaptran.F90
+5 -5
View File
@@ -1345,8 +1345,8 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1702,9 +1702,9 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_dswapdata.F90
+5 -5
View File
@@ -1320,8 +1320,8 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1668,9 +1668,9 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_dswaptran.F90
+5 -5
View File
@@ -1345,8 +1345,8 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1702,9 +1702,9 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_iswapdata.F90
+5 -5
View File
@@ -1320,8 +1320,8 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1668,9 +1668,9 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_iswaptran.F90
+5 -5
View File
@@ -1345,8 +1345,8 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1702,9 +1702,9 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_sswapdata.F90
+5 -5
View File
@@ -1320,8 +1320,8 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1668,9 +1668,9 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_sswaptran.F90
+5 -5
View File
@@ -1345,8 +1345,8 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1702,9 +1702,9 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_zswapdata.F90
+5 -5
View File
@@ -1320,8 +1320,8 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1668,9 +1668,9 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/comm/internals/psi_zswaptran.F90
+5 -5
View File
@@ -1345,8 +1345,8 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
if (debug) write(*,*) me,' wait'
call y%device_wait()
if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
@@ -1702,9 +1702,9 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
!
if (debug) write(*,*) me,' wait'
call y%device_wait()
!!$ if (debug) write(*,*) me,' free buffer'
!!$ call y%free_buffer(info)
!!$ if (info == 0) call y%free_comid(info)
if (debug) write(*,*) me,' free buffer'
call y%maybe_free_buffer(info)
if (info == 0) call y%free_comid(info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
base/modules/psb_realloc_mod.F90
+11
View File
@@ -153,9 +153,20 @@ module psb_realloc_mod
& psb_zsize1d, psb_zsize2d
end interface psb_size
logical, private :: do_maybe_free_buffer = .true.
Contains
function psb_get_maybe_free_buffer() result(res)
logical :: res
res = do_maybe_free_buffer
end function psb_get_maybe_free_buffer
subroutine psb_set_maybe_free_buffer(val)
logical, intent(in) :: val
do_maybe_free_buffer = val
end subroutine psb_set_maybe_free_buffer
subroutine psb_i_ab_cpy1d(vin,vout,info)
use psb_error_mod
base/modules/serial/psb_c_base_vect_mod.f90
+72 -22
View File
@@ -106,6 +106,7 @@ module psb_c_base_vect_mod
procedure, nopass :: use_buffer => c_base_use_buffer
procedure, pass(x) :: new_buffer => c_base_new_buffer
procedure, nopass :: device_wait => c_base_device_wait
procedure, pass(x) :: maybe_free_buffer => c_base_maybe_free_buffer
procedure, pass(x) :: free_buffer => c_base_free_buffer
procedure, pass(x) :: new_comid => c_base_new_comid
procedure, pass(x) :: free_comid => c_base_free_comid
@@ -450,7 +451,6 @@ contains
call x%sync()
end subroutine c_base_asb
!
!> Function base_free:
!! \memberof psb_c_base_vect_type
@@ -477,6 +477,63 @@ contains
!
!> Function base_free_buffer:
!! \memberof psb_c_base_vect_type
!! \brief Free aux buffer
!!
!! \param info return code
!!
!
subroutine c_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine c_base_free_buffer
!
!> Function base_maybe_free_buffer:
!! \memberof psb_c_base_vect_type
!! \brief Conditionally Free aux buffer
!!
!! \param info return code
!!
!
subroutine c_base_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine c_base_maybe_free_buffer
!
!> Function base_free_comid:
!! \memberof psb_c_base_vect_type
!! \brief Free aux MPI communication id buffer
!!
!! \param info return code
!!
!
subroutine c_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine c_base_free_comid
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
@@ -1229,27 +1286,6 @@ contains
end subroutine c_base_new_comid
subroutine c_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine c_base_free_buffer
subroutine c_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine c_base_free_comid
!
! shortcut alpha=1 beta=0
!
@@ -1447,6 +1483,7 @@ module psb_c_base_multivect_mod
procedure, nopass :: use_buffer => c_base_mlv_use_buffer
procedure, pass(x) :: new_buffer => c_base_mlv_new_buffer
procedure, nopass :: device_wait => c_base_mlv_device_wait
procedure, pass(x) :: maybe_free_buffer => c_base_mlv_maybe_free_buffer
procedure, pass(x) :: free_buffer => c_base_mlv_free_buffer
procedure, pass(x) :: new_comid => c_base_mlv_new_comid
procedure, pass(x) :: free_comid => c_base_mlv_free_comid
@@ -2469,6 +2506,19 @@ contains
end subroutine c_base_mlv_new_comid
subroutine c_base_mlv_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_c_base_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine c_base_mlv_maybe_free_buffer
subroutine c_base_mlv_free_buffer(x,info)
use psb_realloc_mod
implicit none
base/modules/serial/psb_d_base_vect_mod.f90
+72 -22
View File
@@ -106,6 +106,7 @@ module psb_d_base_vect_mod
procedure, nopass :: use_buffer => d_base_use_buffer
procedure, pass(x) :: new_buffer => d_base_new_buffer
procedure, nopass :: device_wait => d_base_device_wait
procedure, pass(x) :: maybe_free_buffer => d_base_maybe_free_buffer
procedure, pass(x) :: free_buffer => d_base_free_buffer
procedure, pass(x) :: new_comid => d_base_new_comid
procedure, pass(x) :: free_comid => d_base_free_comid
@@ -450,7 +451,6 @@ contains
call x%sync()
end subroutine d_base_asb
!
!> Function base_free:
!! \memberof psb_d_base_vect_type
@@ -477,6 +477,63 @@ contains
!
!> Function base_free_buffer:
!! \memberof psb_d_base_vect_type
!! \brief Free aux buffer
!!
!! \param info return code
!!
!
subroutine d_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine d_base_free_buffer
!
!> Function base_maybe_free_buffer:
!! \memberof psb_d_base_vect_type
!! \brief Conditionally Free aux buffer
!!
!! \param info return code
!!
!
subroutine d_base_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine d_base_maybe_free_buffer
!
!> Function base_free_comid:
!! \memberof psb_d_base_vect_type
!! \brief Free aux MPI communication id buffer
!!
!! \param info return code
!!
!
subroutine d_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine d_base_free_comid
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
@@ -1229,27 +1286,6 @@ contains
end subroutine d_base_new_comid
subroutine d_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine d_base_free_buffer
subroutine d_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine d_base_free_comid
!
! shortcut alpha=1 beta=0
!
@@ -1447,6 +1483,7 @@ module psb_d_base_multivect_mod
procedure, nopass :: use_buffer => d_base_mlv_use_buffer
procedure, pass(x) :: new_buffer => d_base_mlv_new_buffer
procedure, nopass :: device_wait => d_base_mlv_device_wait
procedure, pass(x) :: maybe_free_buffer => d_base_mlv_maybe_free_buffer
procedure, pass(x) :: free_buffer => d_base_mlv_free_buffer
procedure, pass(x) :: new_comid => d_base_mlv_new_comid
procedure, pass(x) :: free_comid => d_base_mlv_free_comid
@@ -2469,6 +2506,19 @@ contains
end subroutine d_base_mlv_new_comid
subroutine d_base_mlv_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_d_base_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine d_base_mlv_maybe_free_buffer
subroutine d_base_mlv_free_buffer(x,info)
use psb_realloc_mod
implicit none
base/modules/serial/psb_i_base_vect_mod.f90
+72 -22
View File
@@ -105,6 +105,7 @@ module psb_i_base_vect_mod
procedure, nopass :: use_buffer => i_base_use_buffer
procedure, pass(x) :: new_buffer => i_base_new_buffer
procedure, nopass :: device_wait => i_base_device_wait
procedure, pass(x) :: maybe_free_buffer => i_base_maybe_free_buffer
procedure, pass(x) :: free_buffer => i_base_free_buffer
procedure, pass(x) :: new_comid => i_base_new_comid
procedure, pass(x) :: free_comid => i_base_free_comid
@@ -419,7 +420,6 @@ contains
call x%sync()
end subroutine i_base_asb
!
!> Function base_free:
!! \memberof psb_i_base_vect_type
@@ -446,6 +446,63 @@ contains
!
!> Function base_free_buffer:
!! \memberof psb_i_base_vect_type
!! \brief Free aux buffer
!!
!! \param info return code
!!
!
subroutine i_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine i_base_free_buffer
!
!> Function base_maybe_free_buffer:
!! \memberof psb_i_base_vect_type
!! \brief Conditionally Free aux buffer
!!
!! \param info return code
!!
!
subroutine i_base_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine i_base_maybe_free_buffer
!
!> Function base_free_comid:
!! \memberof psb_i_base_vect_type
!! \brief Free aux MPI communication id buffer
!!
!! \param info return code
!!
!
subroutine i_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine i_base_free_comid
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
@@ -770,27 +827,6 @@ contains
end subroutine i_base_new_comid
subroutine i_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine i_base_free_buffer
subroutine i_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine i_base_free_comid
!
! shortcut alpha=1 beta=0
!
@@ -955,6 +991,7 @@ module psb_i_base_multivect_mod
procedure, nopass :: use_buffer => i_base_mlv_use_buffer
procedure, pass(x) :: new_buffer => i_base_mlv_new_buffer
procedure, nopass :: device_wait => i_base_mlv_device_wait
procedure, pass(x) :: maybe_free_buffer => i_base_mlv_maybe_free_buffer
procedure, pass(x) :: free_buffer => i_base_mlv_free_buffer
procedure, pass(x) :: new_comid => i_base_mlv_new_comid
procedure, pass(x) :: free_comid => i_base_mlv_free_comid
@@ -1497,6 +1534,19 @@ contains
end subroutine i_base_mlv_new_comid
subroutine i_base_mlv_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_i_base_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine i_base_mlv_maybe_free_buffer
subroutine i_base_mlv_free_buffer(x,info)
use psb_realloc_mod
implicit none
base/modules/serial/psb_s_base_vect_mod.f90
+72 -22
View File
@@ -106,6 +106,7 @@ module psb_s_base_vect_mod
procedure, nopass :: use_buffer => s_base_use_buffer
procedure, pass(x) :: new_buffer => s_base_new_buffer
procedure, nopass :: device_wait => s_base_device_wait
procedure, pass(x) :: maybe_free_buffer => s_base_maybe_free_buffer
procedure, pass(x) :: free_buffer => s_base_free_buffer
procedure, pass(x) :: new_comid => s_base_new_comid
procedure, pass(x) :: free_comid => s_base_free_comid
@@ -450,7 +451,6 @@ contains
call x%sync()
end subroutine s_base_asb
!
!> Function base_free:
!! \memberof psb_s_base_vect_type
@@ -477,6 +477,63 @@ contains
!
!> Function base_free_buffer:
!! \memberof psb_s_base_vect_type
!! \brief Free aux buffer
!!
!! \param info return code
!!
!
subroutine s_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine s_base_free_buffer
!
!> Function base_maybe_free_buffer:
!! \memberof psb_s_base_vect_type
!! \brief Conditionally Free aux buffer
!!
!! \param info return code
!!
!
subroutine s_base_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine s_base_maybe_free_buffer
!
!> Function base_free_comid:
!! \memberof psb_s_base_vect_type
!! \brief Free aux MPI communication id buffer
!!
!! \param info return code
!!
!
subroutine s_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine s_base_free_comid
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
@@ -1229,27 +1286,6 @@ contains
end subroutine s_base_new_comid
subroutine s_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine s_base_free_buffer
subroutine s_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine s_base_free_comid
!
! shortcut alpha=1 beta=0
!
@@ -1447,6 +1483,7 @@ module psb_s_base_multivect_mod
procedure, nopass :: use_buffer => s_base_mlv_use_buffer
procedure, pass(x) :: new_buffer => s_base_mlv_new_buffer
procedure, nopass :: device_wait => s_base_mlv_device_wait
procedure, pass(x) :: maybe_free_buffer => s_base_mlv_maybe_free_buffer
procedure, pass(x) :: free_buffer => s_base_mlv_free_buffer
procedure, pass(x) :: new_comid => s_base_mlv_new_comid
procedure, pass(x) :: free_comid => s_base_mlv_free_comid
@@ -2469,6 +2506,19 @@ contains
end subroutine s_base_mlv_new_comid
subroutine s_base_mlv_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_s_base_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine s_base_mlv_maybe_free_buffer
subroutine s_base_mlv_free_buffer(x,info)
use psb_realloc_mod
implicit none
base/modules/serial/psb_z_base_vect_mod.f90
+72 -22
View File
@@ -106,6 +106,7 @@ module psb_z_base_vect_mod
procedure, nopass :: use_buffer => z_base_use_buffer
procedure, pass(x) :: new_buffer => z_base_new_buffer
procedure, nopass :: device_wait => z_base_device_wait
procedure, pass(x) :: maybe_free_buffer => z_base_maybe_free_buffer
procedure, pass(x) :: free_buffer => z_base_free_buffer
procedure, pass(x) :: new_comid => z_base_new_comid
procedure, pass(x) :: free_comid => z_base_free_comid
@@ -450,7 +451,6 @@ contains
call x%sync()
end subroutine z_base_asb
!
!> Function base_free:
!! \memberof psb_z_base_vect_type
@@ -477,6 +477,63 @@ contains
!
!> Function base_free_buffer:
!! \memberof psb_z_base_vect_type
!! \brief Free aux buffer
!!
!! \param info return code
!!
!
subroutine z_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine z_base_free_buffer
!
!> Function base_maybe_free_buffer:
!! \memberof psb_z_base_vect_type
!! \brief Conditionally Free aux buffer
!!
!! \param info return code
!!
!
subroutine z_base_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine z_base_maybe_free_buffer
!
!> Function base_free_comid:
!! \memberof psb_z_base_vect_type
!! \brief Free aux MPI communication id buffer
!!
!! \param info return code
!!
!
subroutine z_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine z_base_free_comid
!
! The base version of SYNC & friends does nothing, it's just
! a placeholder.
@@ -1229,27 +1286,6 @@ contains
end subroutine z_base_new_comid
subroutine z_base_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%combuf)) &
& deallocate(x%combuf,stat=info)
end subroutine z_base_free_buffer
subroutine z_base_free_comid(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
if (allocated(x%comid)) &
& deallocate(x%comid,stat=info)
end subroutine z_base_free_comid
!
! shortcut alpha=1 beta=0
!
@@ -1447,6 +1483,7 @@ module psb_z_base_multivect_mod
procedure, nopass :: use_buffer => z_base_mlv_use_buffer
procedure, pass(x) :: new_buffer => z_base_mlv_new_buffer
procedure, nopass :: device_wait => z_base_mlv_device_wait
procedure, pass(x) :: maybe_free_buffer => z_base_mlv_maybe_free_buffer
procedure, pass(x) :: free_buffer => z_base_mlv_free_buffer
procedure, pass(x) :: new_comid => z_base_mlv_new_comid
procedure, pass(x) :: free_comid => z_base_mlv_free_comid
@@ -2469,6 +2506,19 @@ contains
end subroutine z_base_mlv_new_comid
subroutine z_base_mlv_maybe_free_buffer(x,info)
use psb_realloc_mod
implicit none
class(psb_z_base_multivect_type), intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
info = 0
if (psb_get_maybe_free_buffer())&
& call x%free_buffer(info)
end subroutine z_base_mlv_maybe_free_buffer
subroutine z_base_mlv_free_buffer(x,info)
use psb_realloc_mod
implicit none