diff --git a/base/internals/psi_dswaptran.F90 b/base/internals/psi_dswaptran.F90 index 992dfb09..8cf3bb91 100644 --- a/base/internals/psi_dswaptran.F90 +++ b/base/internals/psi_dswaptran.F90 @@ -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 diff --git a/base/internals/psi_iswaptran.F90 b/base/internals/psi_iswaptran.F90 index a2538ccf..214de31b 100644 --- a/base/internals/psi_iswaptran.F90 +++ b/base/internals/psi_iswaptran.F90 @@ -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 diff --git a/base/internals/psi_zswaptran.F90 b/base/internals/psi_zswaptran.F90 index 5c926255..49539996 100644 --- a/base/internals/psi_zswaptran.F90 +++ b/base/internals/psi_zswaptran.F90 @@ -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 diff --git a/base/modules/psi_mod.f90 b/base/modules/psi_mod.f90 index 276f6400..c121305c 100644 --- a/base/modules/psi_mod.f90 +++ b/base/modules/psi_mod.f90 @@ -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