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

psblas:

Browse Source 
internals/psi_dswapdata.F90
internals/psi_dswaptran.F90
internals/psi_iswapdata.F90
internals/psi_iswaptran.F90
internals/psi_zswapdata.F90
internals/psi_zswaptran.F90
modules/psb_desc_type.f90

Defined a new internal routine psb_cd_get_list to access the various
lists in DESC which can be used for data exchange.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 8b2426e217
commit a2aed40f34
7 changed files with 124 additions and 333 deletions
Show Stats Download Patch File Download Diff File

64
base/internals/psi_dswapdata.F90
Unescape Escape View File

@ -152,34 +152,12 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -634,35 +612,11 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n

67
base/internals/psi_dswaptran.F90
Unescape Escape View File

@ -155,34 +155,11 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -632,42 +609,17 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
do_send = swap_mpi .or. swap_sync .or. swap_send
do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then
write(0,*) 'External data present: ',data
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
write(0,*) 'Really wrong?? ',data_, psb_comm_halo_, psb_comm_ovr_, psb_comm_ext_
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -718,7 +670,6 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
end if
idxr = max(idxr,1)
idxs = max(idxs,1)
if((idxr+idxs) < size(work)) then

64
base/internals/psi_iswapdata.F90
Unescape Escape View File

@ -151,34 +151,12 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -634,35 +612,11 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n

62
base/internals/psi_iswaptran.F90
Unescape Escape View File

@ -154,34 +154,11 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -636,34 +613,11 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n

64
base/internals/psi_zswapdata.F90
Unescape Escape View File

@ -151,34 +151,12 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -634,35 +612,11 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n

62
base/internals/psi_zswaptran.F90
Unescape Escape View File

@ -155,34 +155,11 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n
@ -638,34 +615,11 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
d_idx => desc_a%ovrlap_index
totxch = desc_a%matrix_data(psb_tovr_xch_)
idxr = desc_a%matrix_data(psb_tovr_rcv_)
idxs = desc_a%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
d_idx => desc_a%ext_index
totxch = desc_a%matrix_data(psb_text_xch_)
idxr = desc_a%matrix_data(psb_text_rcv_)
idxs = desc_a%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
d_idx => desc_a%ovr_mst_idx
totxch = desc_a%matrix_data(psb_tmov_xch_)
idxr = desc_a%matrix_data(psb_tmov_rcv_)
idxs = desc_a%matrix_data(psb_tmov_snd_)
case default
call psb_errpush(4010,name,a_err='wrong Data selector')
call psb_cd_get_list(data_,desc_a,d_idx,totxch,idxr,idxs,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='psb_cd_get_list')
goto 9999
end select
end if
idxr = idxr * n
idxs = idxs * n

74
base/modules/psb_desc_type.f90
Unescape Escape View File

@ -297,7 +297,8 @@ module psb_descriptor_type
interface psb_sizeof
module procedure psb_cd_sizeof
end interface
integer, private, save :: cd_large_threshold=psb_default_large_threshold
@ -571,5 +572,74 @@ contains
end if
return
end subroutine psb_cd_set_bld
subroutine psb_cd_get_list(data,desc,ipnt,totxch,idxr,idxs,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
integer, intent(in) :: data
integer, pointer :: ipnt(:)
type(psb_desc_type), target :: desc
integer, intent(out) :: totxch,idxr,idxs,info
!locals
integer :: np,me,ictxt,err_act
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20), parameter :: name='psb_cd_get_list'
info = 0
call psb_erractionsave(err_act)
ictxt = psb_cd_get_context(desc)
call psb_info(ictxt, me, np)
select case(data)
case(psb_comm_halo_)
ipnt => desc%halo_index
totxch = desc%matrix_data(psb_thal_xch_)
idxr = desc%matrix_data(psb_thal_rcv_)
idxs = desc%matrix_data(psb_thal_snd_)
case(psb_comm_ovr_)
ipnt => desc%ovrlap_index
totxch = desc%matrix_data(psb_tovr_xch_)
idxr = desc%matrix_data(psb_tovr_rcv_)
idxs = desc%matrix_data(psb_tovr_snd_)
case(psb_comm_ext_)
ipnt => desc%ext_index
totxch = desc%matrix_data(psb_text_xch_)
idxr = desc%matrix_data(psb_text_rcv_)
idxs = desc%matrix_data(psb_text_snd_)
case(psb_comm_mov_)
ipnt => desc%ovr_mst_idx
totxch = desc%matrix_data(psb_tmov_xch_)
idxr = desc%matrix_data(psb_tmov_rcv_)
idxs = desc%matrix_data(psb_tmov_snd_)
case default
info=4010
call psb_errpush(info,name,a_err='wrong Data selector')
goto 9999
end select
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cd_get_list
end module psb_descriptor_type

Write Preview
Loading…
Cancel
Save