[UPDATE] Mid update used to merge communication and fixmpic
Stack-1
2 months ago
parent
d07d12acb5
commit
899c425d01
@ -1,390 +0,0 @@
|
||||
!
|
||||
! Parallel Sparse BLAS version 3.5
|
||||
! (C) Copyright 2006-2018
|
||||
! Salvatore Filippone
|
||||
! Alfredo Buttari
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
! File: psb_dhalo_a_new.f90
|
||||
!
|
||||
! Subroutine: psb_dhalom_new
|
||||
! This subroutine performs the exchange of the halo elements in a
|
||||
! distributed dense matrix between all the processes.
|
||||
! The comm_type argument selects the communication scheme:
|
||||
! psb_comm_type_isend_ (0) = classic irecv/send (default)
|
||||
! psb_comm_type_neigh_a2av_ (1) = MPI_Alltoallv collective
|
||||
!
|
||||
! Arguments:
|
||||
! x - real,dimension(:,:). The local part of the dense matrix.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! comm_type - integer. Communication scheme selector
|
||||
! jx - integer(optional). The starting column of the global matrix.
|
||||
! ik - integer(optional). The number of columns to gather.
|
||||
! work - real(optional). Work area.
|
||||
! tran - character(optional). Transpose exchange.
|
||||
! mode - integer(optional). Communication mode (see Swapdata)
|
||||
! data - integer(optional). Which index list in desc_a should be used.
|
||||
!
|
||||
subroutine psb_dhalom_new(x,desc_a,info,comm_type,jx,ik,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalom_new
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
real(psb_dpk_), intent(inout), target :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in) :: comm_type
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_mpk_) :: np, me, k
|
||||
integer(psb_ipk_) :: err_act, iix, jjx, maxk, nrow, imode, i,&
|
||||
& liwork, data_, ldx
|
||||
integer(psb_lpk_) :: m, n, ix, ijx
|
||||
real(psb_dpk_), pointer :: iwork(:), xp(:,:)
|
||||
character :: tran_
|
||||
character(len=20) :: name, ch_err
|
||||
logical :: aliw
|
||||
|
||||
name='psb_dhalom_new'
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_ ; goto 9999
|
||||
end if
|
||||
|
||||
ctxt=desc_a%get_context()
|
||||
|
||||
! check on blacs grid
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
ix = 1
|
||||
if (present(jx)) then
|
||||
ijx = jx
|
||||
else
|
||||
ijx = 1
|
||||
endif
|
||||
|
||||
m = desc_a%get_global_rows()
|
||||
n = desc_a%get_global_cols()
|
||||
nrow = desc_a%get_local_rows()
|
||||
|
||||
maxk=size(x,2)-ijx+1
|
||||
|
||||
if(present(ik)) then
|
||||
if(ik > maxk) then
|
||||
k=maxk
|
||||
else
|
||||
k=ik
|
||||
end if
|
||||
else
|
||||
k = maxk
|
||||
end if
|
||||
|
||||
if (present(tran)) then
|
||||
tran_ = psb_toupper(tran)
|
||||
else
|
||||
tran_ = 'N'
|
||||
endif
|
||||
|
||||
if (present(data)) then
|
||||
data_ = data
|
||||
else
|
||||
data_ = psb_comm_halo_
|
||||
endif
|
||||
|
||||
!
|
||||
! Select the communication mode based on comm_type
|
||||
!
|
||||
select case(comm_type)
|
||||
case(0)
|
||||
!
|
||||
! Classic irecv/send scheme (default)
|
||||
!
|
||||
if (present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
||||
endif
|
||||
|
||||
case(1)
|
||||
if(present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_start_,psb_swap_wait_)
|
||||
endif
|
||||
|
||||
case default
|
||||
info = psb_err_input_value_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/5_psb_ipk_,comm_type,izero,izero,izero/))
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
ldx = size(x,1)
|
||||
! check vector correctness
|
||||
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_ ; ch_err='psb_chkvect'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
aliw=.false.
|
||||
iwork => work
|
||||
else
|
||||
aliw=.true.
|
||||
allocate(iwork(liwork),stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
else
|
||||
aliw=.true.
|
||||
allocate(iwork(liwork),stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
|
||||
! exchange halo elements
|
||||
xp => x(iix:size(x,1),jjx:jjx+k-1)
|
||||
if(tran_ == 'N') then
|
||||
call psi_swapdata(imode,k,dzero,xp,&
|
||||
& desc_a,iwork,info,data=data_)
|
||||
else if((tran_ == 'T').or.(tran_ == 'C')) then
|
||||
call psi_swaptran(imode,k,done,xp,&
|
||||
&desc_a,iwork,info)
|
||||
else
|
||||
info = psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='invalid tran')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if(info /= psb_success_) then
|
||||
ch_err='PSI_swapdata'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (aliw) deallocate(iwork)
|
||||
nullify(iwork)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_dhalom_new
|
||||
|
||||
|
||||
!
|
||||
! Subroutine: psb_dhalov_new
|
||||
! This subroutine performs the exchange of the halo elements in a
|
||||
! distributed dense vector between all the processes.
|
||||
! The comm_type argument selects the communication scheme:
|
||||
! psb_comm_type_isend_ (0) = classic irecv/send (default)
|
||||
! psb_comm_type_neigh_a2av_ (1) = MPI_Alltoallv collective
|
||||
!
|
||||
! Arguments:
|
||||
! x - real,dimension(:). The local part of the dense vector.
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. Return code
|
||||
! comm_type - integer. Communication scheme selector
|
||||
! work - real(optional). Work area.
|
||||
! tran - character(optional). Transpose exchange.
|
||||
! mode - integer(optional). Communication mode (see Swapdata)
|
||||
! data - integer(optional). Which index list in desc_a should be used.
|
||||
!
|
||||
subroutine psb_dhalov_new(x,desc_a,info,comm_type,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalov_new
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
real(psb_dpk_), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in) :: comm_type
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_mpk_) :: np, me
|
||||
integer(psb_ipk_) :: err_act, ldx, iix, jjx, nrow, imode, liwork, data_
|
||||
integer(psb_lpk_) :: m, n, ix, ijx
|
||||
real(psb_dpk_), pointer :: iwork(:)
|
||||
character :: tran_
|
||||
character(len=20) :: name, ch_err
|
||||
logical :: aliw
|
||||
|
||||
name='psb_dhalov_new'
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_ ; goto 9999
|
||||
end if
|
||||
|
||||
ctxt=desc_a%get_context()
|
||||
|
||||
! check on blacs grid
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
ix = 1
|
||||
ijx = 1
|
||||
|
||||
m = desc_a%get_global_rows()
|
||||
n = desc_a%get_global_cols()
|
||||
nrow = desc_a%get_local_rows()
|
||||
|
||||
if (present(tran)) then
|
||||
tran_ = psb_toupper(tran)
|
||||
else
|
||||
tran_ = 'N'
|
||||
endif
|
||||
|
||||
if (present(data)) then
|
||||
data_ = data
|
||||
else
|
||||
data_ = psb_comm_halo_
|
||||
endif
|
||||
|
||||
!
|
||||
! Select the communication mode based on comm_type
|
||||
!
|
||||
select case(comm_type)
|
||||
case(0)
|
||||
!
|
||||
! Classic irecv/send scheme (default)
|
||||
!
|
||||
if (present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
||||
endif
|
||||
|
||||
case(1)
|
||||
if(present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_start_,psb_swap_wait_)
|
||||
endif
|
||||
|
||||
case default
|
||||
info = psb_err_input_value_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/4_psb_ipk_,comm_type,izero,izero,izero/))
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
ldx = size(x,1)
|
||||
! check vector correctness
|
||||
call psb_chkvect(m,lone,ldx,ix,ijx,desc_a,info,iix,jjx,check_halo=.true.)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_ ; ch_err='psb_chkvect'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
aliw=.false.
|
||||
iwork => work
|
||||
else
|
||||
aliw=.true.
|
||||
allocate(iwork(liwork),stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
else
|
||||
aliw=.true.
|
||||
allocate(iwork(liwork),stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
|
||||
! exchange halo elements
|
||||
if(tran_ == 'N') then
|
||||
call psi_swapdata(imode,dzero,x(iix:size(x)),&
|
||||
& desc_a,iwork,info,data=data_)
|
||||
else if((tran_ == 'T').or.(tran_ == 'C')) then
|
||||
call psi_swaptran(imode,done,x(iix:size(x)),&
|
||||
& desc_a,iwork,info)
|
||||
else
|
||||
info = psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='invalid tran')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if(info /= psb_success_) then
|
||||
ch_err='PSI_swapdata'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (aliw) deallocate(iwork)
|
||||
nullify(iwork)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
|
||||
return
|
||||
end subroutine psb_dhalov_new
|
||||
@ -1,298 +0,0 @@
|
||||
!
|
||||
! Parallel Sparse BLAS version 3.5
|
||||
! (C) Copyright 2006-2018
|
||||
! Salvatore Filippone
|
||||
! Alfredo Buttari
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions
|
||||
! are met:
|
||||
! 1. Redistributions of source code must retain the above copyright
|
||||
! notice, this list of conditions and the following disclaimer.
|
||||
! 2. Redistributions in binary form must reproduce the above copyright
|
||||
! notice, this list of conditions, and the following disclaimer in the
|
||||
! documentation and/or other materials provided with the distribution.
|
||||
! 3. The name of the PSBLAS group or the names of its contributors may
|
||||
! not be used to endorse or promote products derived from this
|
||||
! software without specific written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
|
||||
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
|
||||
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
! POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
! File: psb_dhalo_new.f90
|
||||
!
|
||||
! Subroutine: psb_dhalo_vect_new
|
||||
! Halo exchange for a distributed vector.
|
||||
! comm_type selects the communication scheme:
|
||||
! psb_comm_type_isend_ (0) : classic isend/irecv (delegates to psi_swapdata)
|
||||
! psb_comm_type_neigh_a2av_ (1) : MPI_Neighbor_alltoallv via pre-built topology
|
||||
!
|
||||
subroutine psb_dhalo_vect_new(x,desc_a,info,comm_type,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalo_vect_new
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
|
||||
type(psb_d_vect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in) :: comm_type
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act, &
|
||||
& nrow, ncol, lldx, imode, liwork, data_
|
||||
real(psb_dpk_),pointer :: iwork(:)
|
||||
real(psb_dpk_), allocatable :: sndbuf(:), rcvbuf(:)
|
||||
character :: tran_
|
||||
character(len=40) :: name, ch_err
|
||||
logical :: aliw
|
||||
integer(psb_mpk_) :: iret
|
||||
integer(psb_ipk_) :: k
|
||||
|
||||
name='psb_dhalo_vect_new'
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_ ; goto 9999
|
||||
end if
|
||||
|
||||
ctxt=desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nrow = desc_a%get_local_rows()
|
||||
ncol = desc_a%get_local_cols()
|
||||
lldx = x%get_nrows()
|
||||
|
||||
if (present(tran)) then
|
||||
tran_ = psb_toupper(tran)
|
||||
else
|
||||
tran_ = 'N'
|
||||
endif
|
||||
if (present(data)) then
|
||||
data_ = data
|
||||
else
|
||||
data_ = psb_comm_halo_
|
||||
endif
|
||||
|
||||
if ((info == 0).and.(lldx < ncol)) call x%reall(ncol,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_ ; ch_err='reall'
|
||||
call psb_errpush(info,name,a_err=ch_err); goto 9999
|
||||
end if
|
||||
|
||||
select case(comm_type)
|
||||
case(0) ! psb_comm_type_isend_
|
||||
! ---- Classic isend/irecv: delegate to psi_swapdata ----
|
||||
if (present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
iwork => work; aliw=.false.
|
||||
else
|
||||
aliw=.true.; allocate(iwork(liwork),stat=info)
|
||||
end if
|
||||
else
|
||||
aliw=.true.; allocate(iwork(liwork),stat=info)
|
||||
end if
|
||||
if(info /= psb_success_) then
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if(tran_ == 'N') then
|
||||
call psi_swapdata(imode,dzero,x%v,desc_a,iwork,info,data=data_)
|
||||
else if((tran_ == 'T').or.(tran_ == 'C')) then
|
||||
call psi_swaptran(imode,done,x%v,desc_a,iwork,info)
|
||||
else
|
||||
info = psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='invalid tran'); goto 9999
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ch_err='PSI_swapdata'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (aliw) deallocate(iwork)
|
||||
nullify(iwork)
|
||||
|
||||
case(1) ! psb_comm_type_neigh_a2av_
|
||||
! TODO
|
||||
case default
|
||||
info = psb_err_input_value_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/5_psb_ipk_,comm_type,izero,izero,izero/))
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
return
|
||||
end subroutine psb_dhalo_vect_new
|
||||
|
||||
|
||||
!
|
||||
! Subroutine: psb_dhalo_multivect_new
|
||||
! Halo exchange for a distributed multivector.
|
||||
! comm_type selects the communication scheme:
|
||||
! psb_comm_type_isend_ (0) : classic isend/irecv
|
||||
! psb_comm_type_neigh_a2av_ (1) : MPI_Neighbor_alltoallv via pre-built topology
|
||||
!
|
||||
subroutine psb_dhalo_multivect_new(x,desc_a,info,comm_type,work,tran,mode,data)
|
||||
use psb_base_mod, psb_protect_name => psb_dhalo_multivect_new
|
||||
use psi_mod
|
||||
implicit none
|
||||
|
||||
type(psb_d_multivect_type), intent(inout) :: x
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), intent(in) :: comm_type
|
||||
real(psb_dpk_), target, optional, intent(inout) :: work(:)
|
||||
integer(psb_ipk_), intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
|
||||
! locals
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
integer(psb_ipk_) :: np, me, err_act, &
|
||||
& nrow, ncol, lldx, imode, liwork, data_, nc
|
||||
real(psb_dpk_),pointer :: iwork(:)
|
||||
real(psb_dpk_), allocatable :: sndbuf(:), rcvbuf(:)
|
||||
integer(psb_mpk_), allocatable :: mv_sndcnts(:), mv_rcvcnts(:), &
|
||||
& mv_snddispls(:), mv_rcvdispls(:)
|
||||
character :: tran_
|
||||
character(len=40) :: name, ch_err
|
||||
logical :: aliw
|
||||
integer(psb_mpk_) :: iret
|
||||
integer(psb_ipk_) :: k, j, bp, nn
|
||||
|
||||
name='psb_dhalo_multivect_new'
|
||||
info=psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (psb_errstatus_fatal()) then
|
||||
info = psb_err_internal_error_ ; goto 9999
|
||||
end if
|
||||
|
||||
ctxt=desc_a%get_context()
|
||||
call psb_info(ctxt, me, np)
|
||||
if (np == -1) then
|
||||
info = psb_err_context_error_
|
||||
call psb_errpush(info,name); goto 9999
|
||||
endif
|
||||
|
||||
if (.not.allocated(x%v)) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
call psb_errpush(info,name); goto 9999
|
||||
endif
|
||||
|
||||
nrow = desc_a%get_local_rows()
|
||||
ncol = desc_a%get_local_cols()
|
||||
lldx = x%get_nrows()
|
||||
nc = x%get_ncols()
|
||||
|
||||
if (present(tran)) then
|
||||
tran_ = psb_toupper(tran)
|
||||
else
|
||||
tran_ = 'N'
|
||||
endif
|
||||
if (present(data)) then
|
||||
data_ = data
|
||||
else
|
||||
data_ = psb_comm_halo_
|
||||
endif
|
||||
|
||||
if (lldx < ncol) call x%reall(ncol,nc,info)
|
||||
if(info /= psb_success_) then
|
||||
ch_err='psb_reall'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
select case(comm_type)
|
||||
case(0)
|
||||
! ---- Classic isend/irecv ----
|
||||
if (present(mode)) then
|
||||
imode = mode
|
||||
else
|
||||
imode = IOR(psb_swap_send_,psb_swap_recv_)
|
||||
end if
|
||||
|
||||
liwork=nrow
|
||||
if (present(work)) then
|
||||
if(size(work) >= liwork) then
|
||||
iwork => work; aliw=.false.
|
||||
else
|
||||
aliw=.true.; allocate(iwork(liwork),stat=info)
|
||||
end if
|
||||
else
|
||||
aliw=.true.; allocate(iwork(liwork),stat=info)
|
||||
end if
|
||||
if(info /= psb_success_) then
|
||||
ch_err='psb_realloc'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if(tran_ == 'N') then
|
||||
call psi_swapdata(imode,dzero,x%v,desc_a,iwork,info,data=data_)
|
||||
else if((tran_ == 'T').or.(tran_ == 'C')) then
|
||||
call psi_swaptran(imode,done,x%v,desc_a,iwork,info)
|
||||
else
|
||||
info = psb_err_internal_error_
|
||||
call psb_errpush(info,name,a_err='invalid tran'); goto 9999
|
||||
end if
|
||||
|
||||
if (info /= psb_success_) then
|
||||
ch_err='PSI_swapdata'
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
if (aliw) deallocate(iwork)
|
||||
nullify(iwork)
|
||||
|
||||
case(1)
|
||||
! TODO
|
||||
|
||||
case default
|
||||
info = psb_err_input_value_invalid_i_
|
||||
call psb_errpush(info,name,i_err=(/5_psb_ipk_,comm_type,izero,izero,izero/))
|
||||
goto 9999
|
||||
end select
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 call psb_error_handler(ctxt,err_act)
|
||||
return
|
||||
end subroutine psb_dhalo_multivect_new
|
||||
@ -1,149 +0,0 @@
|
||||
#ifndef PSB_C_BASE__
|
||||
#define PSB_C_BASE__
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
/*typedef char _Bool;*/
|
||||
#endif
|
||||
|
||||
#include <float.h>
|
||||
#ifdef __cplusplus
|
||||
#include <complex>
|
||||
#else
|
||||
#include <complex.h>
|
||||
#endif
|
||||
#include <stdint.h>
|
||||
#include <stddef.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "psb_config.h"
|
||||
#include "psb_types.h"
|
||||
|
||||
|
||||
typedef struct PSB_C_DESCRIPTOR {
|
||||
void *descriptor;
|
||||
} psb_c_descriptor;
|
||||
|
||||
|
||||
typedef struct PSB_C_CTXT {
|
||||
psb_i_t *ctxt;
|
||||
} psb_c_ctxt;
|
||||
|
||||
|
||||
|
||||
void psb_c_check_error(psb_c_ctxt cctxt);
|
||||
psb_i_t psb_c_error();
|
||||
psb_i_t psb_c_clean_errstack();
|
||||
void psb_c_print_errmsg();
|
||||
char *psb_c_pop_errmsg();
|
||||
psb_i_t psb_c_f2c_errmsg(char *, psb_i_t);
|
||||
void psb_c_seterraction_ret();
|
||||
void psb_c_seterraction_print();
|
||||
void psb_c_seterraction_abort();
|
||||
|
||||
/* Environment routines */
|
||||
void psb_c_init(psb_c_ctxt *cctxt);
|
||||
void psb_c_init_from_fint(psb_c_ctxt *cctxt, psb_i_t f_comm);
|
||||
void psb_c_exit(psb_c_ctxt cctxt);
|
||||
void psb_c_exit_ctxt(psb_c_ctxt cctxt);
|
||||
void psb_c_abort(psb_c_ctxt cctxt);
|
||||
void psb_c_barrier(psb_c_ctxt cctxt);
|
||||
void psb_c_info(psb_c_ctxt cctxt, psb_i_t *iam, psb_i_t *np);
|
||||
void psb_c_get_i_ctxt(psb_c_ctxt cctxt, psb_i_t *ictxt, psb_i_t *info);
|
||||
bool psb_c_cmp_ctxt(psb_c_ctxt cctxt1, psb_c_ctxt cctxt2);
|
||||
psb_d_t psb_c_wtime();
|
||||
psb_i_t psb_c_get_errstatus();
|
||||
|
||||
psb_i_t psb_c_get_index_base();
|
||||
void psb_c_set_index_base(psb_i_t base);
|
||||
/* GPU environment routines */
|
||||
#ifdef PSB_HAVE_CUDA
|
||||
void psb_c_cuda_init(psb_c_ctxt *cctxt);
|
||||
void psb_c_cuda_init_opt(psb_c_ctxt *cctxt, psb_m_t ngpu);
|
||||
void psb_c_cuda_exit();
|
||||
psb_m_t psb_c_cuda_getDeviceCount();
|
||||
#endif
|
||||
|
||||
void psb_c_mbcast(psb_c_ctxt cctxt, psb_i_t n, psb_m_t *v, psb_i_t root);
|
||||
void psb_c_ibcast(psb_c_ctxt cctxt, psb_i_t n, psb_i_t *v, psb_i_t root);
|
||||
void psb_c_lbcast(psb_c_ctxt cctxt, psb_i_t n, psb_l_t *v, psb_i_t root);
|
||||
void psb_c_ebcast(psb_c_ctxt cctxt, psb_i_t n, psb_e_t *v, psb_i_t root);
|
||||
void psb_c_sbcast(psb_c_ctxt cctxt, psb_i_t n, psb_s_t *v, psb_i_t root);
|
||||
void psb_c_dbcast(psb_c_ctxt cctxt, psb_i_t n, psb_d_t *v, psb_i_t root);
|
||||
void psb_c_cbcast(psb_c_ctxt cctxt, psb_i_t n, psb_c_t *v, psb_i_t root);
|
||||
void psb_c_zbcast(psb_c_ctxt cctxt, psb_i_t n, psb_z_t *v, psb_i_t root);
|
||||
void psb_c_hbcast(psb_c_ctxt cctxt, const char *v, psb_i_t root);
|
||||
|
||||
/* Descriptor/integer routines */
|
||||
psb_c_descriptor* psb_c_new_descriptor();
|
||||
void psb_c_delete_descriptor(psb_c_descriptor *);
|
||||
psb_c_ctxt* psb_c_new_ctxt();
|
||||
void psb_c_delete_ctxt(psb_c_ctxt *);
|
||||
psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_c_ctxt cctxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_vl_lidx(psb_i_t nl, psb_l_t *vl, psb_i_t *lidx, psb_c_ctxt cctxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_repl(psb_l_t n, psb_c_ctxt cctxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdasb(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdasb_format(psb_c_descriptor *cd, const char *afmt);
|
||||
psb_i_t psb_c_cdfree(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdins(psb_i_t nz, const psb_l_t *ia, const psb_l_t *ja, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdins_lidx(psb_i_t nz, const psb_l_t *ja, const psb_i_t *lidx, psb_c_descriptor *cd);
|
||||
bool psb_c_is_owned(psb_l_t gindex, psb_c_descriptor *cd);
|
||||
bool psb_c_cd_is_asb(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cd_check_addr(psb_c_descriptor *cd);
|
||||
|
||||
|
||||
psb_i_t psb_c_cd_get_local_rows(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cd_get_local_cols(psb_c_descriptor *cd);
|
||||
psb_l_t psb_c_cd_get_global_rows(psb_c_descriptor *cd);
|
||||
psb_l_t psb_c_cd_get_global_cols(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cd_get_global_indices(psb_l_t idx[], psb_i_t nidx, bool owned, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_g2l(psb_c_descriptor *cdh,psb_l_t gindex,bool cowned);
|
||||
|
||||
|
||||
|
||||
/* legal values for afmt */
|
||||
#define PSB_AFMT_CSR "CSR"
|
||||
#define PSB_AFMT_CSC "CSC"
|
||||
#define PSB_AFMT_COO "COO"
|
||||
#define PSB_AFMT_RSB "RSB"
|
||||
|
||||
/* Transpose argument */
|
||||
#define psb_NoTrans_ "N"
|
||||
#define psb_Trans_ "T"
|
||||
#define psb_ConjTrans_ "C"
|
||||
|
||||
#if 0
|
||||
/* legal values for upd argument */
|
||||
#define psb_upd_srch_ 98764
|
||||
#define psb_upd_perm_ 98765
|
||||
#define psb_upd_def_ psb_upd_srch_
|
||||
/* legal values for dupl argument */
|
||||
#define psb_dupl_ovwrt_ 0
|
||||
#define psb_dupl_add_ 1
|
||||
#define psb_dupl_err_ 2
|
||||
#define psb_dupl_def_ psb_dupl_ovwrt_
|
||||
|
||||
/* legal values for halo swap modes argument */
|
||||
#define psb_swap_send_ 1
|
||||
#define psb_swap_recv_ 2
|
||||
#define psb_swap_sync_ 4
|
||||
#define psb_swap_mpi_ 8
|
||||
#define psb_swap_start_ 16
|
||||
#define psb_swap_wait_ 32
|
||||
|
||||
/* legal values for ovrl update argument */
|
||||
#define psb_none_ 0
|
||||
#define psb_sum_ 1
|
||||
#define psb_avg_ 2
|
||||
#define psb_square_root_ 3
|
||||
#define psb_setzero_ 4
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -1,109 +0,0 @@
|
||||
#ifndef PSB_C_CBASE_
|
||||
#define PSB_C_CBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_CVECTOR {
|
||||
void *cvector;
|
||||
} psb_c_cvector;
|
||||
|
||||
typedef struct PSB_C_CSPMAT {
|
||||
void *cspmat;
|
||||
} psb_c_cspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_cvector* psb_c_new_cvector();
|
||||
psb_i_t psb_c_cvect_get_nrows(psb_c_cvector *xh);
|
||||
psb_c_t *psb_c_cvect_get_cpy( psb_c_cvector *xh);
|
||||
psb_i_t psb_c_cvect_f_get_cpy(psb_c_t *v, psb_c_cvector *xh);
|
||||
psb_i_t psb_c_cvect_zero(psb_c_cvector *xh);
|
||||
psb_i_t *psb_c_cvect_f_get_pnt(psb_c_cvector *xh);
|
||||
psb_i_t psb_c_cvect_clone(psb_c_cvector *xh,psb_c_cvector *yh);
|
||||
|
||||
psb_i_t psb_c_cgeall(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeall_remote(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeall_remote_options(psb_c_cvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t bldmode, psb_i_t duple);
|
||||
psb_i_t psb_c_cgeins(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val,
|
||||
psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_c_t *val,
|
||||
psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeasb(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeasb_options(psb_c_cvector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
|
||||
psb_i_t psb_c_cgeasb_options_format(psb_c_cvector *xh, psb_c_descriptor *cdh,
|
||||
const char *fmt, psb_i_t dupl);
|
||||
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_cspmat* psb_c_new_cspmat();
|
||||
psb_i_t psb_c_cspall(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspall_remote(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspasb(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspfree(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
|
||||
const psb_c_t *val, psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cmat_get_nrows(psb_c_cspmat *mh);
|
||||
psb_i_t psb_c_cmat_get_ncols(psb_c_cspmat *mh);
|
||||
psb_l_t psb_c_cnnz(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_cis_matupd(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_cis_matasb(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_cis_matbld(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cset_matupd(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cset_matasb(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cset_matbld(psb_c_cspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_ccopy_mat(psb_c_cspmat *ah,psb_c_cspmat *bh,psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_cspasb_opt(psb_c_cspmat *mh, psb_c_descriptor *cdh,
|
||||
const char *afmt, psb_i_t upd, psb_i_t dupl);
|
||||
psb_i_t psb_c_csprn(psb_c_cspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_cmat_name_print(psb_c_cspmat *mh, char *name);
|
||||
psb_i_t psb_c_cvect_set_scal(psb_c_cvector *xh, psb_c_t val);
|
||||
psb_i_t psb_c_cvect_set_vect(psb_c_cvector *xh, psb_c_t *val, psb_i_t n);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_c_t psb_c_cgedot(psb_c_cvector *xh, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgeamax(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgeasum(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrmi(psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeaxpby(psb_c_t alpha, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeaxpbyz(psb_c_t alpha, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_cvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspmm(psb_c_t alpha, psb_c_cspmat *ah, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspmm_opt(psb_c_t alpha, psb_c_cspmat *ah, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_cspsm(psb_c_t alpha, psb_c_cspmat *th, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
/* Additional computational routines */
|
||||
psb_i_t psb_c_cgemlt(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgemlt2(psb_c_t alpha, psb_c_cvector *xh, psb_c_cvector *yh, psb_c_t beta, psb_c_cvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgediv(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgediv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_cgediv2(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgediv2_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *zh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_cgeinv(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeinv_check(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_cgeabs(psb_c_cvector *xh,psb_c_cvector *yh,psb_c_cvector *cdh);
|
||||
psb_i_t psb_c_cgecmp(psb_c_cvector *xh,psb_s_t ch,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
bool psb_c_cgecmpmat(psb_c_cspmat *ah,psb_c_cspmat *bh,psb_s_t tol,psb_c_descriptor *cdh);
|
||||
bool psb_c_cgecmpmat_val(psb_c_cspmat *ah,psb_c_t val,psb_s_t tol,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeaddconst(psb_c_cvector *xh,psb_c_t bh,psb_c_cvector *zh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2_weight(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2_weightmask(psb_c_cvector *xh,psb_c_cvector *wh,psb_c_cvector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspscal(psb_c_t alpha, psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspscalpid(psb_c_t alpha, psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspaxpby(psb_c_t alpha, psb_c_cspmat *ah, psb_c_t beta, psb_c_cspmat *bh, psb_c_descriptor *cdh);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -1,113 +0,0 @@
|
||||
#ifndef PSB_C_DBASE_
|
||||
#define PSB_C_DBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_DVECTOR {
|
||||
void *dvector;
|
||||
} psb_c_dvector;
|
||||
|
||||
typedef struct PSB_C_DSPMAT {
|
||||
void *dspmat;
|
||||
} psb_c_dspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_dvector* psb_c_new_dvector();
|
||||
psb_i_t psb_c_dvect_get_nrows(psb_c_dvector *xh);
|
||||
psb_d_t *psb_c_dvect_get_cpy( psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_f_get_cpy(psb_d_t *v, psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_zero(psb_c_dvector *xh);
|
||||
psb_d_t *psb_c_dvect_f_get_pnt( psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_clone(psb_c_dvector *xh,psb_c_dvector *yh);
|
||||
|
||||
psb_i_t psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeall_remote(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeall_remote_options(psb_c_dvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t bldmode, psb_i_t duple);
|
||||
psb_i_t psb_c_dgeins(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeasb_options(psb_c_dvector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
|
||||
psb_i_t psb_c_dgeasb_options_format(psb_c_dvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t dupl, const char *fmt);
|
||||
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_dspmat* psb_c_new_dspmat();
|
||||
psb_i_t psb_c_dspall(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspall_remote(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspasb(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspfree(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
|
||||
const psb_d_t *val, psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dmat_get_nrows(psb_c_dspmat *mh);
|
||||
psb_i_t psb_c_dmat_get_ncols(psb_c_dspmat *mh);
|
||||
psb_l_t psb_c_dnnz(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_dis_matupd(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_dis_matasb(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_dis_matbld(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dset_matupd(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dset_matasb(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dset_matbld(psb_c_dspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dcopy_mat(psb_c_dspmat *ah,psb_c_dspmat *bh,psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh,
|
||||
const char *afmt, psb_i_t upd, psb_i_t dupl);
|
||||
psb_i_t psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_dmat_name_print(psb_c_dspmat *mh, char *name);
|
||||
psb_i_t psb_c_dvect_set_scal(psb_c_dvector *xh, psb_d_t val);
|
||||
psb_i_t psb_c_dvect_set_vect(psb_c_dvector *xh, psb_d_t *val, psb_i_t n);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_d_t psb_c_dgedot(psb_c_dvector *xh, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgeamax(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgeasum(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrmi(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeaxpby(psb_d_t alpha, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeaxpbyz(psb_d_t alpha, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_dvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspmm(psb_d_t alpha, psb_c_dspmat *ah, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspmm_opt(psb_d_t alpha, psb_c_dspmat *ah, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_dspsm(psb_d_t alpha, psb_c_dspmat *th, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
/* Additional computational routines */
|
||||
psb_i_t psb_c_dgemlt(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgemlt2(psb_d_t alpha, psb_c_dvector *xh, psb_c_dvector *yh, psb_d_t beta, psb_c_dvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgediv(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgediv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_dgediv2(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgediv2_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_dvector *zh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_dgeinv(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeinv_check(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_dgeabs(psb_c_dvector *xh,psb_c_dvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgecmp(psb_c_dvector *xh,psb_d_t ch,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
bool psb_c_dgecmpmat(psb_c_dspmat *ah,psb_c_dspmat *bh,psb_d_t tol,psb_c_descriptor *cdh);
|
||||
bool psb_c_dgecmpmat_val(psb_c_dspmat *ah,psb_d_t val,psb_d_t tol,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeaddconst(psb_c_dvector *xh,psb_d_t bh,psb_c_dvector *zh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2_weight(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2_weightmask(psb_c_dvector *xh,psb_c_dvector *wh,psb_c_dvector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dmask(psb_c_dvector *ch,psb_c_dvector *xh,psb_c_dvector *mh, bool *t, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgemin(psb_c_dvector *xh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dminquotient(psb_c_dvector *xh,psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspscal(psb_d_t alpha, psb_c_dspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspscalpid(psb_d_t alpha, psb_c_dspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspaxpby(psb_d_t alpha, psb_c_dspmat *ah, psb_d_t beta, psb_c_dspmat *bh, psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -1,110 +0,0 @@
|
||||
#ifndef PSB_C_SBASE_
|
||||
#define PSB_C_SBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_SVECTOR {
|
||||
void *svector;
|
||||
} psb_c_svector;
|
||||
|
||||
typedef struct PSB_C_SSPMAT {
|
||||
void *sspmat;
|
||||
} psb_c_sspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_svector* psb_c_new_svector();
|
||||
psb_i_t psb_c_svect_get_nrows(psb_c_svector *xh);
|
||||
psb_s_t *psb_c_svect_get_cpy( psb_c_svector *xh);
|
||||
psb_i_t psb_c_svect_f_get_cpy(psb_s_t *v, psb_c_svector *xh);
|
||||
psb_i_t psb_c_svect_zero(psb_c_svector *xh);
|
||||
psb_s_t *psb_c_svect_f_get_pnt( psb_c_svector *xh);
|
||||
psb_i_t psb_c_svect_clone(psb_c_svector *xh,psb_c_svector *yh);
|
||||
|
||||
psb_i_t psb_c_sgeall(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeall_remote(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeall_remote_options(psb_c_svector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t bldmode, psb_i_t duple);
|
||||
psb_i_t psb_c_sgeins(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val,
|
||||
psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_s_t *val,
|
||||
psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeasb(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeasb_options(psb_c_svector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
|
||||
psb_i_t psb_c_sgeasb_options_format(psb_c_svector *xh, psb_c_descriptor *cdh,
|
||||
const char *fmt, psb_i_t dupl);
|
||||
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_sspmat* psb_c_new_sspmat();
|
||||
psb_i_t psb_c_sspall(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspall_remote(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspasb(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspfree(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
|
||||
const psb_s_t *val, psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_smat_get_nrows(psb_c_sspmat *mh);
|
||||
psb_i_t psb_c_smat_get_ncols(psb_c_sspmat *mh);
|
||||
psb_l_t psb_c_snnz(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_sis_matupd(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_sis_matasb(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_sis_matbld(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sset_matupd(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sset_matasb(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sset_matbld(psb_c_sspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_scopy_mat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_sspasb_opt(psb_c_sspmat *mh, psb_c_descriptor *cdh,
|
||||
const char *afmt, psb_i_t upd, psb_i_t dupl);
|
||||
psb_i_t psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_smat_name_print(psb_c_sspmat *mh, char *name);
|
||||
psb_i_t psb_c_svect_set_scal(psb_c_svector *xh, psb_s_t val);
|
||||
psb_i_t psb_c_svect_set_vect(psb_c_svector *xh, psb_s_t *val, psb_i_t n);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_s_t psb_c_sgedot(psb_c_svector *xh, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgeamax(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgeasum(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrmi(psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeaxpby(psb_s_t alpha, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeaxpbyz(psb_s_t alpha, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_svector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspmm(psb_s_t alpha, psb_c_sspmat *ah, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspmm_opt(psb_s_t alpha, psb_c_sspmat *ah, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_sspsm(psb_s_t alpha, psb_c_sspmat *th, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
/* Additional computational routines */
|
||||
psb_i_t psb_c_sgemlt(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgemlt2(psb_s_t alpha, psb_c_svector *xh, psb_c_svector *yh, psb_s_t beta, psb_c_svector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgediv(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgediv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_sgediv2(psb_c_svector *xh,psb_c_svector *yh,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgediv2_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_svector *zh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_sgeinv(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeinv_check(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_sgeabs(psb_c_svector *xh,psb_c_svector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgecmp(psb_c_svector *xh,psb_s_t ch,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
bool psb_c_sgecmpmat(psb_c_sspmat *ah,psb_c_sspmat *bh,psb_s_t tol,psb_c_descriptor *cdh);
|
||||
bool psb_c_sgecmpmat_val(psb_c_sspmat *ah,psb_s_t val,psb_s_t tol,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeaddconst(psb_c_svector *xh,psb_s_t bh,psb_c_svector *zh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2_weight(psb_c_svector *xh,psb_c_svector *wh,psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2_weightmask(psb_c_svector *xh,psb_c_svector *wh,psb_c_svector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_smask(psb_c_svector *ch,psb_c_svector *xh,psb_c_svector *mh, bool *t, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgemin(psb_c_svector *xh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspscal(psb_s_t alpha, psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspscalpid(psb_s_t alpha, psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspaxpby(psb_s_t alpha, psb_c_sspmat *ah, psb_s_t beta, psb_c_sspmat *bh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -1,110 +0,0 @@
|
||||
#ifndef PSB_C_ZBASE_
|
||||
#define PSB_C_ZBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_ZVECTOR {
|
||||
void *zvector;
|
||||
} psb_c_zvector;
|
||||
|
||||
typedef struct PSB_C_ZSPMAT {
|
||||
void *zspmat;
|
||||
} psb_c_zspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_zvector* psb_c_new_zvector();
|
||||
psb_i_t psb_c_zvect_get_nrows(psb_c_zvector *xh);
|
||||
psb_z_t *psb_c_zvect_get_cpy( psb_c_zvector *xh);
|
||||
psb_i_t psb_c_zvect_f_get_cpy(psb_z_t *v, psb_c_zvector *xh);
|
||||
psb_i_t psb_c_zvect_zero(psb_c_zvector *xh);
|
||||
psb_z_t *psb_c_zvect_f_get_pnt( psb_c_zvector *xh);
|
||||
psb_i_t psb_c_zvect_clone(psb_c_zvector *xh,psb_c_zvector *yh);
|
||||
|
||||
psb_i_t psb_c_zgeall(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeall_remote(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeall_remote_options(psb_c_zvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t bldmode, psb_i_t duple);
|
||||
psb_i_t psb_c_zgeins(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val,
|
||||
psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeins_add(psb_i_t nz, const psb_l_t *irw, const psb_z_t *val,
|
||||
psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeasb(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeasb_options(psb_c_zvector *xh, psb_c_descriptor *cdh, psb_i_t dupl);
|
||||
psb_i_t psb_c_zgeasb_options_format(psb_c_zvector *xh, psb_c_descriptor *cdh,
|
||||
const char *fmt, psb_i_t dupl);
|
||||
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_zspmat* psb_c_new_zspmat();
|
||||
psb_i_t psb_c_zspall(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspall_remote(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspasb(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspfree(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,
|
||||
const psb_z_t *val, psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zmat_get_nrows(psb_c_zspmat *mh);
|
||||
psb_i_t psb_c_zmat_get_ncols(psb_c_zspmat *mh);
|
||||
psb_l_t psb_c_znnz(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_zis_matupd(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_zis_matasb(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
bool psb_c_zis_matbld(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zset_matupd(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zset_matasb(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zset_matbld(psb_c_zspmat *mh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zcopy_mat(psb_c_zspmat *ah,psb_c_zspmat *bh,psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
psb_i_t psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh,
|
||||
const char *afmt, psb_i_t upd, psb_i_t dupl);
|
||||
psb_i_t psb_c_zsprn(psb_c_zspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_zmat_name_print(psb_c_zspmat *mh, char *name);
|
||||
psb_i_t psb_c_zvect_set_scal(psb_c_zvector *xh, psb_z_t val);
|
||||
psb_i_t psb_c_zvect_set_vect(psb_c_zvector *xh, psb_z_t *val, psb_i_t n);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_z_t psb_c_zgedot(psb_c_zvector *xh, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgeamax(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgeasum(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrmi(psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeaxpby(psb_z_t alpha, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeaxpbyz(psb_z_t alpha, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_zvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspmm(psb_z_t alpha, psb_c_zspmat *ah, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspmm_opt(psb_z_t alpha, psb_c_zspmat *ah, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_zspsm(psb_z_t alpha, psb_c_zspmat *th, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
/* Additional computational routines */
|
||||
psb_i_t psb_c_zgemlt(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgemlt2(psb_z_t alpha, psb_c_zvector *xh, psb_c_zvector *yh, psb_z_t beta, psb_c_zvector *zh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgediv(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgediv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_zgediv2(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgediv2_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_zvector *zh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_zgeinv(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeinv_check(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh, bool flag);
|
||||
psb_i_t psb_c_zgeabs(psb_c_zvector *xh,psb_c_zvector *yh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgecmp(psb_c_zvector *xh,psb_d_t ch,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
bool psb_c_zgecmpmat(psb_c_zspmat *ah,psb_c_zspmat *bh,psb_d_t tol,psb_c_descriptor *cdh);
|
||||
bool psb_c_zgecmpmat_val(psb_c_zspmat *ah,psb_z_t val,psb_d_t tol,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeaddconst(psb_c_zvector *xh,psb_z_t bh,psb_c_zvector *zh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2_weight(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2_weightmask(psb_c_zvector *xh,psb_c_zvector *wh,psb_c_zvector *idvh,psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspscal(psb_z_t alpha, psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspscalpid(psb_z_t alpha, psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspaxpby(psb_z_t alpha, psb_c_zspmat *ah, psb_z_t beta, psb_c_zspmat *bh, psb_c_descriptor *cdh);
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,285 @@
|
||||
!
|
||||
! Test program for D-type halo exchange: baseline vs neighbor topology.
|
||||
!
|
||||
! This test uses the psb_halo_new interface with encapsulated vectors
|
||||
! to compare the two communication paths:
|
||||
!
|
||||
! 1. Baseline (Isend/Irecv) : comm_type = 0 (psb_comm_type_isend_)
|
||||
! 2. Neighbor topology (Ineighbor_alltoallv) : comm_type = 1 (psb_comm_type_neigh_a2av_)
|
||||
!
|
||||
! NOTE: The neighbor topology communication requires encapsulated vectors
|
||||
! (psb_d_vect_type).
|
||||
!
|
||||
! It builds a 3D block-partitioned descriptor with a 7-point stencil,
|
||||
! fills owned entries with their global index, performs halo exchange
|
||||
! via both paths, then checks:
|
||||
! (a) The two paths produce identical results (cross-check)
|
||||
! (b) Every halo entry equals the global index of its source (absolute check)
|
||||
!
|
||||
! Run with: mpirun -np <P> ./test_halo_new_api
|
||||
!
|
||||
program test_halo_new_api
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
! ---- grid parameters ----
|
||||
integer(psb_ipk_) :: idim
|
||||
integer(psb_ipk_) :: argc
|
||||
character(len=32) :: arg
|
||||
|
||||
! ---- parallel context ----
|
||||
type(psb_ctxt_type) :: ctxt
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer(psb_ipk_) :: my_rank, np, info, i, nr, nlr
|
||||
integer(psb_lpk_) :: m, nt
|
||||
integer(psb_lpk_), allocatable :: myidx(:)
|
||||
|
||||
! ---- encapsulated vectors for halo exchange ----
|
||||
! NOTE: Must use psb_d_vect_type (not plain arrays) for neighbor topology to work
|
||||
! No work buffer needed for psb_halo
|
||||
type(psb_d_vect_type) :: v_baseline, v_neighbor
|
||||
|
||||
! ---- temporary arrays ----
|
||||
real(psb_dpk_), allocatable :: vals(:)
|
||||
real(psb_dpk_), allocatable :: res_bl(:), res_nb(:)
|
||||
|
||||
! ---- local sizes ----
|
||||
integer(psb_ipk_) :: nrow, ncol
|
||||
|
||||
! ---- communication type constants ----
|
||||
integer(psb_ipk_), parameter :: psb_comm_type_isend_ = 0
|
||||
integer(psb_ipk_), parameter :: psb_comm_type_neigh_a2av_ = 1
|
||||
|
||||
! ---- test results ----
|
||||
integer(psb_ipk_) :: n_pass, n_total
|
||||
real(psb_dpk_) :: err, tol
|
||||
integer(psb_lpk_), allocatable :: glob_col(:)
|
||||
real(psb_dpk_), allocatable :: expected(:)
|
||||
character(len=40) :: name
|
||||
|
||||
name = 'test_halo_new_api'
|
||||
tol = 1.0d-12
|
||||
n_pass = 0
|
||||
n_total = 0
|
||||
|
||||
! ---- parse command-line argument for idim ----
|
||||
idim = 10
|
||||
argc = command_argument_count()
|
||||
do i = 1, argc
|
||||
call get_command_argument(i, arg)
|
||||
if (trim(arg) == '--dim') then
|
||||
if (i < argc) then
|
||||
call get_command_argument(i+1, arg)
|
||||
read(arg, *) idim
|
||||
exit
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
|
||||
if (idim <= 0) then
|
||||
write(*,*) 'Invalid grid size specified. Usage: --dim <positive integer>'
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
|
||||
|
||||
! ==================================================================
|
||||
! 1. Initialise MPI / PSBLAS context
|
||||
! ==================================================================
|
||||
call psb_init(ctxt)
|
||||
call psb_info(ctxt, my_rank, np)
|
||||
|
||||
if (my_rank == 0) then
|
||||
write(psb_out_unit,'("================================================")')
|
||||
write(psb_out_unit,'(" Test: D-type halo using psb_halo interface")')
|
||||
write(psb_out_unit,'(" Processes : ",i0)') np
|
||||
write(psb_out_unit,'(" Grid : ",i0," x ",i0," x ",i0)') idim, idim, idim
|
||||
write(psb_out_unit,'("================================================")')
|
||||
end if
|
||||
|
||||
! ==================================================================
|
||||
! 2. Build descriptor with 7-point stencil connectivity
|
||||
! ==================================================================
|
||||
m = (1_psb_lpk_ * idim) * idim * idim
|
||||
nt = (m + np - 1) / np
|
||||
nr = max(0, min(int(nt,psb_ipk_), int(m - (my_rank * nt),psb_ipk_)))
|
||||
|
||||
call psb_cdall(ctxt, desc_a, info, nl=nr)
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) my_rank, 'cdall error:', info
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
myidx = desc_a%get_global_indices()
|
||||
nlr = size(myidx)
|
||||
|
||||
! Insert 7-point stencil connectivity for 3D grid
|
||||
do i = 1, nlr
|
||||
call psb_cdins(1_psb_ipk_, (/myidx(i)/), (/myidx(i)/), desc_a, info)
|
||||
if (myidx(i) > 1) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), (/myidx(i)-1/), desc_a, info)
|
||||
if (myidx(i) < m) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), (/myidx(i)+1/), desc_a, info)
|
||||
if (myidx(i) > idim) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), (/myidx(i)-idim/), desc_a, info)
|
||||
if (myidx(i) + idim <= m) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), (/myidx(i)+idim/), desc_a, info)
|
||||
if (myidx(i) > int(idim,psb_lpk_)*idim) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), &
|
||||
& (/myidx(i) - int(idim,psb_lpk_)*idim/), desc_a, info)
|
||||
if (myidx(i) + int(idim,psb_lpk_)*idim <= m) &
|
||||
& call psb_cdins(1_psb_ipk_, (/myidx(i)/), &
|
||||
& (/myidx(i) + int(idim,psb_lpk_)*idim/), desc_a, info)
|
||||
end do
|
||||
|
||||
call psb_cdasb(desc_a, info)
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) my_rank, 'cdasb error:', info
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
nrow = desc_a%get_local_rows() ! owned
|
||||
ncol = desc_a%get_local_cols() ! owned + halo
|
||||
|
||||
! ==================================================================
|
||||
! 3. Allocate encapsulated vectors and fill owned entries
|
||||
! ==================================================================
|
||||
call psb_geall(v_baseline, desc_a, info)
|
||||
call psb_geall(v_neighbor, desc_a, info)
|
||||
call psb_geasb(v_baseline, desc_a, info, scratch=.true.)
|
||||
call psb_geasb(v_neighbor, desc_a, info, scratch=.true.)
|
||||
|
||||
allocate(vals(ncol))
|
||||
vals = dzero
|
||||
do i = 1, nlr
|
||||
vals(i) = real(myidx(i), psb_dpk_)
|
||||
end do
|
||||
call v_baseline%set_vect(vals)
|
||||
call v_neighbor%set_vect(vals)
|
||||
deallocate(vals)
|
||||
|
||||
! ==================================================================
|
||||
! 4. Build the expected result for halo positions
|
||||
! global_column_indices(j) = global index of local column j
|
||||
! After halo exchange every position j should hold global_column_indices(j).
|
||||
! ==================================================================
|
||||
allocate(glob_col(ncol), expected(ncol))
|
||||
glob_col = desc_a%get_global_indices(owned=.false.)
|
||||
do i = 1, ncol
|
||||
expected(i) = real(glob_col(i), psb_dpk_)
|
||||
end do
|
||||
|
||||
! ==================================================================
|
||||
! 5. Baseline halo exchange (Isend/Irecv)
|
||||
! Uses comm_type = 0 (psb_comm_type_isend_)
|
||||
! ==================================================================
|
||||
call psb_halo_new(v_baseline, desc_a, info, comm_type=psb_comm_type_isend_)
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) my_rank, 'baseline halo error:', info
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
! ==================================================================
|
||||
! 6. Neighbor topology halo exchange
|
||||
! Uses comm_type = 1 (psb_comm_type_neigh_a2av_)
|
||||
! ==================================================================
|
||||
call psb_halo_new(v_neighbor, desc_a, info, comm_type=psb_comm_type_neigh_a2av_)
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) my_rank, 'neighbor halo error:', info
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
! ==================================================================
|
||||
! 7. Extract results and compare
|
||||
! ==================================================================
|
||||
res_bl = v_baseline%get_vect()
|
||||
res_nb = v_neighbor%get_vect()
|
||||
|
||||
! ---- Test 1: cross-check baseline vs neighbor (all entries) ----
|
||||
n_total = n_total + 1
|
||||
err = maxval(abs(res_bl(1:ncol) - res_nb(1:ncol)))
|
||||
call psb_amx(ctxt, err)
|
||||
if (my_rank == 0) then
|
||||
if (err < tol) then
|
||||
write(psb_out_unit,'(" [PASS] cross-check baseline vs neighbor : err = ",es12.5)') err
|
||||
n_pass = n_pass + 1
|
||||
else
|
||||
write(psb_out_unit,'(" [FAIL] cross-check baseline vs neighbor : err = ",es12.5)') err
|
||||
end if
|
||||
end if
|
||||
|
||||
! ---- Test 2: baseline absolute correctness (halo = global index) ----
|
||||
n_total = n_total + 1
|
||||
err = maxval(abs(res_bl(1:ncol) - expected(1:ncol)))
|
||||
call psb_amx(ctxt, err)
|
||||
if (my_rank == 0) then
|
||||
if (err < tol) then
|
||||
write(psb_out_unit,'(" [PASS] baseline absolute correctness : err = ",es12.5)') err
|
||||
n_pass = n_pass + 1
|
||||
else
|
||||
write(psb_out_unit,'(" [FAIL] baseline absolute correctness : err = ",es12.5)') err
|
||||
end if
|
||||
end if
|
||||
|
||||
! ---- Test 3: neighbor absolute correctness (halo = global index) ----
|
||||
n_total = n_total + 1
|
||||
err = maxval(abs(res_nb(1:ncol) - expected(1:ncol)))
|
||||
call psb_amx(ctxt, err)
|
||||
if (my_rank == 0) then
|
||||
if (err < tol) then
|
||||
write(psb_out_unit,'(" [PASS] neighbor absolute correctness : err = ",es12.5)') err
|
||||
n_pass = n_pass + 1
|
||||
else
|
||||
write(psb_out_unit,'(" [FAIL] neighbor absolute correctness : err = ",es12.5)') err
|
||||
end if
|
||||
end if
|
||||
|
||||
! ---- Test 4: repeat neighbor exchange (topology reuse) ----
|
||||
do i = nrow+1, ncol
|
||||
res_nb(i) = dzero
|
||||
end do
|
||||
call v_neighbor%set_vect(res_nb)
|
||||
|
||||
call psb_halo_new(v_neighbor, desc_a, info, comm_type=psb_comm_type_neigh_a2av_)
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) my_rank, 'neighbor halo reuse error:', info
|
||||
call psb_abort(ctxt)
|
||||
end if
|
||||
|
||||
res_nb = v_neighbor%get_vect()
|
||||
n_total = n_total + 1
|
||||
err = maxval(abs(res_nb(1:ncol) - expected(1:ncol)))
|
||||
call psb_amx(ctxt, err)
|
||||
if (my_rank == 0) then
|
||||
if (err < tol) then
|
||||
write(psb_out_unit,'(" [PASS] neighbor topology reuse : err = ",es12.5)') err
|
||||
n_pass = n_pass + 1
|
||||
else
|
||||
write(psb_out_unit,'(" [FAIL] neighbor topology reuse : err = ",es12.5)') err
|
||||
end if
|
||||
end if
|
||||
|
||||
! ==================================================================
|
||||
! 8. Summary
|
||||
! ==================================================================
|
||||
if (my_rank == 0) then
|
||||
write(psb_out_unit,'("================================================")')
|
||||
write(psb_out_unit,'(" Results: ",i0," / ",i0," tests passed")') n_pass, n_total
|
||||
if (n_pass == n_total) then
|
||||
write(psb_out_unit,'(" STATUS: ALL PASSED")')
|
||||
else
|
||||
write(psb_out_unit,'(" STATUS: SOME FAILURES")')
|
||||
end if
|
||||
write(psb_out_unit,'("================================================")')
|
||||
end if
|
||||
|
||||
! ==================================================================
|
||||
! 9. Cleanup
|
||||
! ==================================================================
|
||||
deallocate(res_bl, res_nb, expected, glob_col)
|
||||
call psb_gefree(v_baseline, desc_a, info)
|
||||
call psb_gefree(v_neighbor, desc_a, info)
|
||||
call psb_cdfree(desc_a, info)
|
||||
call psb_exit(ctxt)
|
||||
|
||||
end program test_halo_new_api
|
||||
Loading…
Reference in New Issue