fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

aligned single precision -- psi_dswapdata and psi_sswapdata, removed _vidx_vect functions

Browse Source
communication_v2
federicamontes 2 months ago
parent e7e8a69373
commit 476167577f
3 changed files with 117 additions and 265 deletions
Show Stats Download Patch File Download Diff File

3
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -113,7 +113,6 @@ contains
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, total_send, total_recv, num_neighbors, data_, err_act
class(psb_i_base_vect_type), pointer :: comm_indexes
character(len=20) :: name
! local variables used to detect the communication scheme
logical :: swap_mpi, swap_sync, swap_send, swap_recv, swap_start, swap_wait
@ -631,7 +630,7 @@ contains
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, total_send, total_recv, num_neighbors, data_, err_act
class(psb_i_base_vect_type), pointer :: comm_indexes
character(len=20) :: name
character(len=30) :: name
info = psb_success_
name = 'psi_dswapdata_multivect'

336
base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

@ -105,25 +105,34 @@ contains
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
type(psb_desc_type), target :: desc_a
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
type(psb_desc_type), target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, total_send, total_recv, num_neighbors, data_, err_act
class(psb_i_base_vect_type), pointer :: comm_indexes
! local variables used to detect the communication scheme
logical :: swap_mpi, swap_sync, swap_send, swap_recv, swap_start, swap_wait
logical :: baseline, neighbor_a2av
! error handling variables
integer(psb_ipk_) :: err_act
integer(psb_mpk_) :: me, np
character(len=30) :: name
info=psb_success_
name='psi_swap_datav'
name='psi_sswapdata_vect'
call psb_erractionsave(err_act)
ctxt = desc_a%get_context()
icomm = ctxt%get_mpic()
call psb_info(ctxt,me,np)
if (np == -1) then
info=psb_err_context_error_
@ -149,122 +158,50 @@ contains
goto 9999
end if
call psi_swapdata(ctxt,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psi_sswapdata_vect
!
!
! Subroutine: psi_sswap_vidx_vect
! Data exchange among processes.
!
! Takes care of Y an exanspulated vector. Relies on the gather/scatter methods
! of vectors.
!
! The real workhorse: the outer routine will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
module subroutine psi_sswap_vidx_vect(ctxt,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info)
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
swap_start = iand(flag,psb_swap_start_) /= 0
swap_wait = iand(flag,psb_swap_wait_) /= 0
baseline = swap_mpi .or. swap_send .or. swap_recv .or. swap_sync
neighbor_a2av = swap_start .or. swap_wait
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
!integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! local variables used to detect the communication scheme
logical :: swap_mpi, swap_sync, swap_send, swap_recv, swap_start, swap_wait
logical :: baseline, neighbor_a2av
! local variable used for get the communicator
integer(psb_mpk_) :: icomm
! error handling variables
integer(psb_ipk_) :: err_act
integer(psb_mpk_) :: me, np
character(len=30) :: name
info=psb_success_
name='psi_sswap_vidx_vect'
call psb_erractionsave(err_act)
call psb_info(ctxt,me,np)
if (np == -1) then
info=psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
swap_start = iand(flag,psb_swap_start_) /= 0
swap_wait = iand(flag,psb_swap_wait_) /= 0
baseline = swap_mpi .or. swap_send .or. swap_recv .or. swap_sync
neighbor_a2av = swap_start .or. swap_wait
icomm = ctxt%get_mpic()
if( (baseline.eqv..true.).and.(neighbor_a2av.eqv..true.) ) then
info=psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: both baseline and neighbor_a2av are true')
goto 9999
end if
if (baseline) then
call psi_sswap_baseline_vect(ctxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='baseline swap')
if( (baseline.eqv..true.).and.(neighbor_a2av.eqv..true.) ) then
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: both baseline and neighbor_a2av are true')
goto 9999
end if
else if (neighbor_a2av) then
call psi_sswap_neighbor_topology_vect(ctxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='neighbor a2av swap')
if (baseline) then
call psi_dswap_baseline_vect(ctxt,flag,beta,y,comm_indexes,num_neighbors,total_send,total_recv,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='baseline swap')
goto 9999
end if
else if (neighbor_a2av) then
call psi_dswap_neighbor_topology_vect(ctxt,flag,beta,y,comm_indexes,num_neighbors,total_send,total_recv,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='neighbor a2av swap')
goto 9999
end if
else
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: neither baseline nor neighbor_a2av is true')
goto 9999
end if
else
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: neither baseline nor neighbor_a2av is true')
goto 9999
end if
call psb_erractionrestore(err_act)
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
return
end subroutine psi_sswapdata_vect
end subroutine psi_sswap_vidx_vect
@ -694,25 +631,30 @@ end subroutine psi_sswap_neighbor_topology_vect
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
type(psb_desc_type), target :: desc_a
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
type(psb_desc_type), target :: desc_a
real(psb_spk_), target :: work(:)
integer(psb_ipk_), optional :: data
! locals
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: icomm
integer(psb_ipk_) :: np, me, idxs, idxr, totxch, data_, err_act
class(psb_i_base_vect_type), pointer :: d_vidx
character(len=20) :: name
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: np, me, total_send, total_recv, num_neighbors, data_, err_act
class(psb_i_base_vect_type), pointer :: comm_indexes
character(len=30) :: name
! local variables used to detect the communication scheme
logical :: swap_mpi, swap_sync, swap_send, swap_recv, swap_start, swap_wait
logical :: baseline, neighbor_a2av
info=psb_success_
name='psi_swap_datav'
name='psi_sswapdata_multivect'
call psb_erractionsave(err_act)
ctxt = desc_a%get_context()
icomm = ctxt%get_mpic()
call psb_info(ctxt,me,np)
if (np == -1) then
info=psb_err_context_error_
@ -738,120 +680,52 @@ end subroutine psi_sswap_neighbor_topology_vect
goto 9999
end if
call psi_swapdata(ctxt,flag,beta,y,d_vidx,totxch,idxs,idxr,work,info)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
end subroutine psi_sswapdata_multivect
!
!
! Subroutine: psi_sswap_vidx_multivect
! Data exchange among processes.
!
! Takes care of Y an encapsulated multivector. Relies on the gather/scatter methods
! of multivectors.
!
! The real workhorse: the outer routine will only choose the index list
! this one takes the index list and does the actual exchange.
!
!
!
module subroutine psi_sswap_vidx_multivect(ctxt,flag,beta,y,idx, &
& totxch,totsnd,totrcv,work,info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt
!integer(psb_mpk_), intent(in) :: icomm
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
! local variables used to detect the communication scheme
logical :: swap_mpi, swap_sync, swap_send, swap_recv, swap_start, swap_wait
logical :: baseline, neighbor_a2av
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
swap_start = iand(flag,psb_swap_start_) /= 0
swap_wait = iand(flag,psb_swap_wait_) /= 0
! local variable used to get communicator
integer(psb_mpk_) :: icomm
! error handling variables
integer(psb_ipk_) :: err_act
integer(psb_mpk_) :: me, np
character(len=30) :: name
info=psb_success_
name='psi_sswap_vidx_multivect'
call psb_erractionsave(err_act)
call psb_info(ctxt,me,np)
if (np == -1) then
info=psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
swap_mpi = iand(flag,psb_swap_mpi_) /= 0
swap_sync = iand(flag,psb_swap_sync_) /= 0
swap_send = iand(flag,psb_swap_send_) /= 0
swap_recv = iand(flag,psb_swap_recv_) /= 0
swap_start = iand(flag,psb_swap_start_) /= 0
swap_wait = iand(flag,psb_swap_wait_) /= 0
baseline = swap_mpi .or. swap_send .or. swap_recv .or. swap_sync
neighbor_a2av = swap_start .or. swap_wait
icomm = ctxt%get_mpic()
if( (baseline.eqv..true.).and.(neighbor_a2av.eqv..true.) ) then
info=psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: both baseline and neighbor_a2av are true')
goto 9999
end if
baseline = swap_mpi .or. swap_send .or. swap_recv .or. swap_sync
neighbor_a2av = swap_start .or. swap_wait
icomm = ctxt%get_mpic()
if (baseline) then
call psi_sswap_baseline_multivect(ctxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='baseline swap')
if( (baseline.eqv..true.).and.(neighbor_a2av.eqv..true.) ) then
info=psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: both baseline and neighbor_a2av are true')
goto 9999
end if
else if (neighbor_a2av) then
call psi_sswap_neighbor_topology_multivect(ctxt,icomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='neighbor a2av swap')
if (baseline) then
call psi_dswap_baseline_multivect(ctxt,flag,beta,y,comm_indexes,num_neighbors,total_send,total_recv,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='baseline swap')
goto 9999
end if
else if (neighbor_a2av) then
call psi_dswap_neighbor_topology_multivect(ctxt,flag,beta,y,comm_indexes,num_neighbors,total_send,total_recv,info)
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='neighbor a2av swap')
goto 9999
end if
else
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: neither baseline nor neighbor_a2av is true')
goto 9999
end if
else
info = psb_err_mpi_error_
call psb_errpush(info,name,a_err='Incompatible flag settings: neither baseline nor neighbor_a2av is true')
goto 9999
end if
call psb_erractionrestore(err_act)
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ctxt,err_act)
return
return
end subroutine psi_sswapdata_multivect
end subroutine psi_sswap_vidx_multivect

43
base/modules/comm/psi_s_comm_v_mod.f90
Unescape Escape View File

@ -39,46 +39,25 @@ module psi_s_comm_v_mod
module subroutine psi_sswapdata_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswapdata_vect
module subroutine psi_sswapdata_multivect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_),target :: work(:)
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_sswapdata_multivect
module subroutine psi_sswap_vidx_vect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_sswap_vidx_vect
module subroutine psi_sswap_vidx_multivect(ctxt,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_multivect_type) :: y
real(psb_spk_), intent(in) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(inout) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_sswap_vidx_multivect
end interface psi_swapdata
interface psi_swaptran
module subroutine psi_sswaptran_vect(flag,beta,y,desc_a,work,info,data)
integer(psb_ipk_), intent(in) :: flag

Write Preview
Loading…
Cancel
Save