Changed internal selection of data_ in swaptran. Adjusted interface in

psi_mod (was horribly out of date!!!!!).
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent 5eefa7a6cb
commit 47fe430a5f

@ -109,7 +109,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,& & idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
integer, pointer :: d_idx(:) integer, pointer :: d_idx(:)
@ -149,29 +149,34 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
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_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n
@ -577,7 +582,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, & & idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti & idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
@ -620,30 +625,35 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then write(0,*) 'External data present: ',data
d_idx => desc_a%halo_index data_ = data
totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 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')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n

@ -109,7 +109,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,& & idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
integer, pointer :: d_idx(:) integer, pointer :: d_idx(:)
@ -148,29 +148,34 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
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_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n
@ -576,7 +581,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, & & idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti & idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
@ -618,30 +623,33 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
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_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n

@ -109,7 +109,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, idx_pt,& & idxs, idxr, iret, err_act, totxch, i, idx_pt,&
& snd_pt, rcv_pt, pnti & snd_pt, rcv_pt, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
integer, pointer :: d_idx(:) integer, pointer :: d_idx(:)
@ -149,29 +149,34 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
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_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n
@ -577,7 +582,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,& integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& idxs, idxr, iret, err_act, totxch, i, & & idxs, idxr, iret, err_act, totxch, i, &
& idx_pt, snd_pt, rcv_pt, n, pnti & idx_pt, snd_pt, rcv_pt, n, pnti, data_
integer, allocatable, dimension(:) :: bsdidx, brvidx,& integer, allocatable, dimension(:) :: bsdidx, brvidx,&
& sdsz, rvsz, prcid, rvhd, sdhd & sdsz, rvsz, prcid, rvhd, sdhd
@ -620,30 +625,33 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
do_recv = swap_mpi .or. swap_sync .or. swap_recv do_recv = swap_mpi .or. swap_sync .or. swap_recv
if(present(data)) then if(present(data)) then
if(data == psb_comm_halo_) then data_ = data
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_)
else if(data == psb_comm_ovr_) then
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_)
else
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_)
end if
else else
data_ = psb_comm_halo_
end if
select case(data_)
case(psb_comm_halo_)
d_idx => desc_a%halo_index d_idx => desc_a%halo_index
totxch = desc_a%matrix_data(psb_thal_xch_) totxch = desc_a%matrix_data(psb_thal_xch_)
idxr = desc_a%matrix_data(psb_thal_rcv_) idxr = desc_a%matrix_data(psb_thal_rcv_)
idxs = desc_a%matrix_data(psb_thal_snd_) idxs = desc_a%matrix_data(psb_thal_snd_)
end if
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 default
call psb_errpush(4010,name,a_err='wrong Data selector')
goto 9999
end select
idxr = idxr * n idxr = idxr * n
idxs = idxs * n idxs = idxs * n

@ -151,53 +151,59 @@ module psi_mod
interface psi_swaptran interface psi_swaptran
subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info) subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag, n integer, intent(in) :: flag, n
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)) :: y(:,:), beta real(kind(1.d0)) :: y(:,:), beta
real(kind(1.d0)),target :: work(:) real(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_dswaptranm end subroutine psi_dswaptranm
subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info) subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag integer, intent(in) :: flag
integer, intent(out) :: info integer, intent(out) :: info
real(kind(1.d0)) :: y(:), beta real(kind(1.d0)) :: y(:), beta
real(kind(1.d0)),target :: work(:) real(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_dswaptranv end subroutine psi_dswaptranv
subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info) subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag, n integer, intent(in) :: flag, n
integer, intent(out) :: info integer, intent(out) :: info
integer :: y(:,:), beta integer :: y(:,:), beta
integer,target :: work(:) integer,target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_iswaptranm end subroutine psi_iswaptranm
subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info) subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag integer, intent(in) :: flag
integer, intent(out) :: info integer, intent(out) :: info
integer :: y(:), beta integer :: y(:), beta
integer,target :: work(:) integer,target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_iswaptranv end subroutine psi_iswaptranv
subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info) subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag, n integer, intent(in) :: flag, n
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)) :: y(:,:), beta complex(kind(1.d0)) :: y(:,:), beta
complex(kind(1.d0)),target :: work(:) complex(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_zswaptranm end subroutine psi_zswaptranm
subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info) subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
use psb_descriptor_type use psb_descriptor_type
integer, intent(in) :: flag integer, intent(in) :: flag
integer, intent(out) :: info integer, intent(out) :: info
complex(kind(1.d0)) :: y(:), beta complex(kind(1.d0)) :: y(:), beta
complex(kind(1.d0)),target :: work(:) complex(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_zswaptranv end subroutine psi_zswaptranv
end interface end interface

Loading…
Cancel
Save