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

Changed internal selection of data_ in swaptran. Adjusted interface in

Browse Source 
psi_mod (was horribly out of date!!!!!).
This commit is contained in:
Salvatore Filippone
2008-01-14 17:55:30 +00:00
parent 5eefa7a6cb
commit 47fe430a5f
4 changed files with 152 additions and 120 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/internals/psi_dswaptran.F90
+48 -38
View File
@@ -109,7 +109,7 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& sdsz, rvsz, prcid, rvhd, sdhd
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
if(present(data)) then
if(data == psb_comm_halo_) then
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
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_)
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
idxs = idxs * n
@@ -577,7 +582,7 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& 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
if(present(data)) then
if(data == psb_comm_halo_) then
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
write(0,*) 'External data present: ',data
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_)
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
idxs = idxs * n
base/internals/psi_iswaptran.F90
+46 -38
View File
@@ -109,7 +109,7 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& sdsz, rvsz, prcid, rvhd, sdhd
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
if(present(data)) then
if(data == psb_comm_halo_) then
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
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_)
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
idxs = idxs * n
@@ -576,7 +581,7 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& 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
if(present(data)) then
if(data == psb_comm_halo_) then
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
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_)
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
idxs = idxs * n
base/internals/psi_zswaptran.F90
+46 -38
View File
@@ -109,7 +109,7 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& sdsz, rvsz, prcid, rvhd, sdhd
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
if(present(data)) then
if(data == psb_comm_halo_) then
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
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_)
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
idxs = idxs * n
@@ -577,7 +582,7 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data)
integer :: ictxt, np, me, nesd, nerv,&
& proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),&
& 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,&
& 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
if(present(data)) then
if(data == psb_comm_halo_) then
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
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_)
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
idxs = idxs * n
base/modules/psi_mod.f90
+12 -6
View File
@@ -151,53 +151,59 @@ module psi_mod
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
integer, intent(in) :: flag, n
integer, intent(out) :: info
real(kind(1.d0)) :: y(:,:), beta
real(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
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
integer, intent(in) :: flag
integer, intent(out) :: info
real(kind(1.d0)) :: y(:), beta
real(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
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
integer, intent(in) :: flag, n
integer, intent(out) :: info
integer :: y(:,:), beta
integer,target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
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
integer, intent(in) :: flag
integer, intent(out) :: info
integer :: y(:), beta
integer,target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
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
integer, intent(in) :: flag, n
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:,:), beta
complex(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
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
integer, intent(in) :: flag
integer, intent(out) :: info
complex(kind(1.d0)) :: y(:), beta
complex(kind(1.d0)),target :: work(:)
type(psb_desc_type), target :: desc_a
integer, optional :: data
end subroutine psi_zswaptranv
end interface