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

New SPHALO CSR version, suitable for new MLD. To be fully tested yet.

Browse Source
new-parstruct
Salvatore Filippone 6 years ago
parent 8b26f6d6c7
commit 839b82ff94
8 changed files with 112 additions and 44 deletions
Show Stats Download Patch File Download Diff File

5
base/modules/tools/psb_c_tools_mod.f90
Unescape Escape View File

@ -267,15 +267,16 @@ Module psb_c_tools_mod
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
end Subroutine psb_csphalo end Subroutine psb_csphalo
Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
import import
implicit none implicit none
Type(psb_c_csr_sparse_mat),Intent(in) :: a Type(psb_c_csr_sparse_mat),Intent(in) :: a
Type(psb_c_csr_sparse_mat),Intent(inout) :: blk Type(psb_c_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a Type(psb_desc_type),Intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
end Subroutine psb_c_csr_halo end Subroutine psb_c_csr_halo
end interface end interface

5
base/modules/tools/psb_d_tools_mod.f90
Unescape Escape View File

@ -267,15 +267,16 @@ Module psb_d_tools_mod
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
end Subroutine psb_dsphalo end Subroutine psb_dsphalo
Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
import import
implicit none implicit none
Type(psb_d_csr_sparse_mat),Intent(in) :: a Type(psb_d_csr_sparse_mat),Intent(in) :: a
Type(psb_d_csr_sparse_mat),Intent(inout) :: blk Type(psb_d_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a Type(psb_desc_type),Intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
end Subroutine psb_d_csr_halo end Subroutine psb_d_csr_halo
end interface end interface

5
base/modules/tools/psb_s_tools_mod.f90
Unescape Escape View File

@ -267,15 +267,16 @@ Module psb_s_tools_mod
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
end Subroutine psb_ssphalo end Subroutine psb_ssphalo
Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
import import
implicit none implicit none
Type(psb_s_csr_sparse_mat),Intent(in) :: a Type(psb_s_csr_sparse_mat),Intent(in) :: a
Type(psb_s_csr_sparse_mat),Intent(inout) :: blk Type(psb_s_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a Type(psb_desc_type),Intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
end Subroutine psb_s_csr_halo end Subroutine psb_s_csr_halo
end interface end interface

5
base/modules/tools/psb_z_tools_mod.f90
Unescape Escape View File

@ -267,15 +267,16 @@ Module psb_z_tools_mod
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
end Subroutine psb_zsphalo end Subroutine psb_zsphalo
Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
import import
implicit none implicit none
Type(psb_z_csr_sparse_mat),Intent(in) :: a Type(psb_z_csr_sparse_mat),Intent(in) :: a
Type(psb_z_csr_sparse_mat),Intent(inout) :: blk Type(psb_z_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a Type(psb_desc_type),Intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
end Subroutine psb_z_csr_halo end Subroutine psb_z_csr_halo
end interface end interface

34
base/tools/psb_csphalo.F90
Unescape Escape View File

@ -591,7 +591,7 @@ End Subroutine psb_csphalo
Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
use psb_base_mod, psb_protect_name => psb_c_csr_halo use psb_base_mod, psb_protect_name => psb_c_csr_halo
#ifdef MPI_MOD #ifdef MPI_MOD
@ -602,12 +602,13 @@ Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h' include 'mpif.h'
#endif #endif
Type(psb_c_csr_sparse_mat),Intent(in) :: a type(psb_c_csr_sparse_mat),Intent(in) :: a
Type(psb_c_csr_sparse_mat),Intent(inout) :: blk type(psb_c_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a type(psb_desc_type),intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: counter,proc,i, & integer(psb_ipk_) :: counter,proc,i, &
@ -624,14 +625,15 @@ Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
integer(psb_ipk_), pointer :: idxv(:) integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:) integer(psb_ipk_), allocatable :: ipdxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_
Type(psb_desc_type), pointer :: col_desc_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
name='psb_csphalo' name='psb_c_csr_sphalo'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
@ -672,6 +674,16 @@ Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
else else
data_ = psb_comm_halo_ data_ = psb_comm_halo_
endif endif
if (present(outcol_glob)) then
outcol_glob_ = outcol_glob
else
outcol_glob_ = .false.
endif
if (present(col_desc)) then
col_desc_ => col_desc
else
col_desc_ => desc_a
end if
Allocate(brvindx(np+1),& Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
@ -817,7 +829,7 @@ Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr
if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I') if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I')
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_loc_to_glob') call psb_errpush(info,name,a_err='psb_loc_to_glob')
@ -859,7 +871,11 @@ Subroutine psb_c_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
! Convert into local numbering ! Convert into local numbering
! !
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') !
! This seems to be the correct output condition
!
if (colcnv_.and.(.not.outcol_glob_)) &
& call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

34
base/tools/psb_dsphalo.F90
Unescape Escape View File

@ -591,7 +591,7 @@ End Subroutine psb_dsphalo
Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
use psb_base_mod, psb_protect_name => psb_d_csr_halo use psb_base_mod, psb_protect_name => psb_d_csr_halo
#ifdef MPI_MOD #ifdef MPI_MOD
@ -602,12 +602,13 @@ Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h' include 'mpif.h'
#endif #endif
Type(psb_d_csr_sparse_mat),Intent(in) :: a type(psb_d_csr_sparse_mat),Intent(in) :: a
Type(psb_d_csr_sparse_mat),Intent(inout) :: blk type(psb_d_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a type(psb_desc_type),intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: counter,proc,i, & integer(psb_ipk_) :: counter,proc,i, &
@ -624,14 +625,15 @@ Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
integer(psb_ipk_), pointer :: idxv(:) integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:) integer(psb_ipk_), allocatable :: ipdxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_
Type(psb_desc_type), pointer :: col_desc_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
name='psb_dsphalo' name='psb_d_csr_sphalo'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
@ -672,6 +674,16 @@ Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
else else
data_ = psb_comm_halo_ data_ = psb_comm_halo_
endif endif
if (present(outcol_glob)) then
outcol_glob_ = outcol_glob
else
outcol_glob_ = .false.
endif
if (present(col_desc)) then
col_desc_ => col_desc
else
col_desc_ => desc_a
end if
Allocate(brvindx(np+1),& Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
@ -817,7 +829,7 @@ Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr
if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I') if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I')
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_loc_to_glob') call psb_errpush(info,name,a_err='psb_loc_to_glob')
@ -859,7 +871,11 @@ Subroutine psb_d_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
! Convert into local numbering ! Convert into local numbering
! !
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') !
! This seems to be the correct output condition
!
if (colcnv_.and.(.not.outcol_glob_)) &
& call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

34
base/tools/psb_ssphalo.F90
Unescape Escape View File

@ -591,7 +591,7 @@ End Subroutine psb_ssphalo
Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
use psb_base_mod, psb_protect_name => psb_s_csr_halo use psb_base_mod, psb_protect_name => psb_s_csr_halo
#ifdef MPI_MOD #ifdef MPI_MOD
@ -602,12 +602,13 @@ Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h' include 'mpif.h'
#endif #endif
Type(psb_s_csr_sparse_mat),Intent(in) :: a type(psb_s_csr_sparse_mat),Intent(in) :: a
Type(psb_s_csr_sparse_mat),Intent(inout) :: blk type(psb_s_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a type(psb_desc_type),intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: counter,proc,i, & integer(psb_ipk_) :: counter,proc,i, &
@ -624,14 +625,15 @@ Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
integer(psb_ipk_), pointer :: idxv(:) integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:) integer(psb_ipk_), allocatable :: ipdxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_
Type(psb_desc_type), pointer :: col_desc_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
name='psb_ssphalo' name='psb_s_csr_sphalo'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
@ -672,6 +674,16 @@ Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
else else
data_ = psb_comm_halo_ data_ = psb_comm_halo_
endif endif
if (present(outcol_glob)) then
outcol_glob_ = outcol_glob
else
outcol_glob_ = .false.
endif
if (present(col_desc)) then
col_desc_ => col_desc
else
col_desc_ => desc_a
end if
Allocate(brvindx(np+1),& Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
@ -817,7 +829,7 @@ Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr
if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I') if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I')
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_loc_to_glob') call psb_errpush(info,name,a_err='psb_loc_to_glob')
@ -859,7 +871,11 @@ Subroutine psb_s_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
! Convert into local numbering ! Convert into local numbering
! !
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') !
! This seems to be the correct output condition
!
if (colcnv_.and.(.not.outcol_glob_)) &
& call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

34
base/tools/psb_zsphalo.F90
Unescape Escape View File

@ -591,7 +591,7 @@ End Subroutine psb_zsphalo
Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,& Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
& rowscale,colscale,data) & rowscale,colscale,data,outcol_glob,col_desc)
use psb_base_mod, psb_protect_name => psb_z_csr_halo use psb_base_mod, psb_protect_name => psb_z_csr_halo
#ifdef MPI_MOD #ifdef MPI_MOD
@ -602,12 +602,13 @@ Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
include 'mpif.h' include 'mpif.h'
#endif #endif
Type(psb_z_csr_sparse_mat),Intent(in) :: a type(psb_z_csr_sparse_mat),Intent(in) :: a
Type(psb_z_csr_sparse_mat),Intent(inout) :: blk type(psb_z_csr_sparse_mat),Intent(inout) :: blk
Type(psb_desc_type),Intent(in), target :: desc_a type(psb_desc_type),intent(in), target :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale logical, optional, intent(in) :: rowcnv,colcnv,rowscale,colscale,outcol_glob
integer(psb_ipk_), intent(in), optional :: data integer(psb_ipk_), intent(in), optional :: data
type(psb_desc_type),Intent(in), optional, target :: col_desc
! ...local scalars.... ! ...local scalars....
integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: counter,proc,i, & integer(psb_ipk_) :: counter,proc,i, &
@ -624,14 +625,15 @@ Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
integer(psb_ipk_), pointer :: idxv(:) integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:) integer(psb_ipk_), allocatable :: ipdxv(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_ logical :: rowcnv_,colcnv_,rowscale_,colscale_,outcol_glob_
Type(psb_desc_type), pointer :: col_desc_
character(len=5) :: outfmt_ character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
name='psb_zsphalo' name='psb_z_csr_sphalo'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999 info = psb_err_internal_error_ ; goto 9999
@ -672,6 +674,16 @@ Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
else else
data_ = psb_comm_halo_ data_ = psb_comm_halo_
endif endif
if (present(outcol_glob)) then
outcol_glob_ = outcol_glob
else
outcol_glob_ = .false.
endif
if (present(col_desc)) then
col_desc_ => col_desc
else
col_desc_ => desc_a
end if
Allocate(brvindx(np+1),& Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info) & rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
@ -817,7 +829,7 @@ Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
if (debug_level >= psb_debug_outer_)& if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr & write(debug_unit,*) me,' ',trim(name),': Going for alltoallv',iszs,iszr
if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I') if (rowcnv_) call psb_loc_to_glob(iasnd(1:nz),desc_a,info,iact='I')
if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),desc_a,info,iact='I') if (colcnv_) call psb_loc_to_glob(jasnd(1:nz),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_loc_to_glob') call psb_errpush(info,name,a_err='psb_loc_to_glob')
@ -859,7 +871,11 @@ Subroutine psb_z_csr_halo(a,desc_a,blk,info,rowcnv,colcnv,&
! Convert into local numbering ! Convert into local numbering
! !
if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I') if (rowcnv_) call psb_glob_to_loc(acoo%ia(1:iszr),desc_a,info,iact='I')
if (colcnv_) call psb_glob_to_loc(acoo%ja(1:iszr),desc_a,info,iact='I') !
! This seems to be the correct output condition
!
if (colcnv_.and.(.not.outcol_glob_)) &
& call psb_glob_to_loc(acoo%ja(1:iszr),col_desc_,info,iact='I')
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

Write Preview
Loading…
Cancel
Save