Further advances in IPK vs LPK.

ILmat
Salvatore Filippone 8 years ago
parent d8eff28219
commit dc2e1cd36b

@ -63,11 +63,13 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
complex(psb_spk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
complex(psb_spk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -63,11 +63,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
real(psb_dpk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
real(psb_dpk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -63,11 +63,13 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
integer(psb_epk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
integer(psb_epk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -63,11 +63,13 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
integer(psb_mpk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
integer(psb_mpk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -63,11 +63,13 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
real(psb_spk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
real(psb_spk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -63,11 +63,13 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
complex(psb_dpk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
name='psb_scatterm'
@ -185,8 +187,8 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
do col=1, k
! prepare vector to scatter
@ -299,10 +301,12 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx
integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx
complex(psb_dpk_), allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
integer(psb_ipk_), allocatable :: displ(:), all_dim(:)
integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit
@ -417,8 +421,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_,rootrank,icomm,info)
& psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info)
! prepare vector to scatter
if (iam == iroot) then

@ -85,28 +85,19 @@ subroutine psi_i_crea_bnd_elem(bndel,desc_a,info)
call psb_msort_unique(work(1:i),j)
if (.true.) then
if (j>=0) then
call psb_realloc(j,bndel,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
bndel(1:j) = work(1:j)
else
if (allocated(bndel)) then
deallocate(bndel)
end if
end if
else
call psb_realloc(j+1,bndel,info)
if (j>=0) then
call psb_realloc(j,bndel,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
bndel(1:j) = work(1:j)
bndel(j+1) = -1
endif
else
if (allocated(bndel)) then
deallocate(bndel)
end if
end if
deallocate(work)
call psb_erractionrestore(err_act)

@ -211,6 +211,7 @@ module psb_desc_mod
type(psb_i_vect_type) :: v_ovrlap_index
type(psb_i_vect_type) :: v_ovr_mst_idx
integer(psb_lpk_), allocatable :: tmp_ovrlap_index(:)
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
integer(psb_ipk_), allocatable :: bnd_elem(:)
integer(psb_ipk_), allocatable :: lprm(:)
@ -475,7 +476,7 @@ contains
function psb_cd_get_global_rows(desc) result(val)
implicit none
integer(psb_ipk_) :: val
integer(psb_lpk_) :: val
class(psb_desc_type), intent(in) :: desc
if (allocated(desc%indxmap)) then
@ -488,7 +489,7 @@ contains
function psb_cd_get_global_cols(desc) result(val)
implicit none
integer(psb_ipk_) :: val
integer(psb_lpk_) :: val
class(psb_desc_type), intent(in) :: desc
if (allocated(desc%indxmap)) then
@ -1072,7 +1073,93 @@ contains
end subroutine psb_cd_clone
Subroutine psb_cd_get_recv_idx(tmp,desc,data,info,toglob)
Subroutine psb_cd_get_recv_idx_loc(tmp,desc,data,info)
use psb_error_mod
use psb_penv_mod
use psb_realloc_mod
Implicit None
integer(psb_ipk_), allocatable, intent(out) :: tmp(:)
integer(psb_ipk_), intent(in) :: data
Type(psb_desc_type), Intent(in), target :: desc
integer(psb_ipk_), intent(out) :: info
! .. Local Scalars ..
integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,&
& idx, proc, n_elem_send, n_elem_recv
integer(psb_ipk_), pointer :: idxlist(:)
integer(psb_ipk_) :: debug_level, debug_unit, err_act
character(len=20) :: name
name = 'psb_cd_get_recv_idx'
info = psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = psb_cd_get_context(desc)
call psb_info(ictxt, me, np)
select case(data)
case(psb_comm_halo_)
idxlist => desc%halo_index
case(psb_comm_ovr_)
idxlist => desc%ovrlap_index
case(psb_comm_ext_)
idxlist => desc%ext_index
case(psb_comm_mov_)
idxlist => desc%ovr_mst_idx
write(psb_err_unit,*) 'Warning: unusual request getidx on ovr_mst_idx'
case default
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='wrong Data selector')
goto 9999
end select
l_tmp = 3*size(idxlist)
allocate(tmp(l_tmp),stat=info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
incnt = 1
outcnt = 1
tmp(:) = -1
Do While (idxlist(incnt) /= -1)
proc = idxlist(incnt+psb_proc_id_)
n_elem_recv = idxlist(incnt+psb_n_elem_recv_)
n_elem_send = idxlist(incnt+n_elem_recv+psb_n_elem_send_)
Do j=0,n_elem_recv-1
idx = idxlist(incnt+psb_elem_recv_+j)
call psb_ensure_size((outcnt+3),tmp,info,pad=-1_psb_ipk_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
tmp(outcnt) = proc
tmp(outcnt+1) = 1
tmp(outcnt+2) = idx
tmp(outcnt+3) = -1
outcnt = outcnt+3
end Do
incnt = incnt+n_elem_recv+n_elem_send+3
end Do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end Subroutine psb_cd_get_recv_idx_loc
Subroutine psb_cd_get_recv_idx_glob(tmp,desc,data,info)
use psb_error_mod
use psb_penv_mod
@ -1082,7 +1169,6 @@ contains
integer(psb_ipk_), intent(in) :: data
Type(psb_desc_type), Intent(in), target :: desc
integer(psb_ipk_), intent(out) :: info
logical, intent(in) :: toglob
! .. Local Scalars ..
integer(psb_ipk_) :: incnt, outcnt, j, np, me, ictxt, l_tmp,&
@ -1142,23 +1228,17 @@ contains
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
if (toglob) then
call desc%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then
info=-3
call psb_errpush(info,name)
goto 9999
endif
tmp(outcnt) = proc
tmp(outcnt+1) = 1
tmp(outcnt+2) = gidx
tmp(outcnt+3) = -1
else
tmp(outcnt) = proc
tmp(outcnt+1) = 1
tmp(outcnt+2) = idx
tmp(outcnt+3) = -1
end if
call desc%indxmap%l2g(idx,gidx,info)
If (gidx < 0) then
info=-3
call psb_errpush(info,name)
goto 9999
endif
tmp(outcnt) = proc
tmp(outcnt+1) = 1
tmp(outcnt+2) = gidx
tmp(outcnt+3) = -1
outcnt = outcnt+3
end Do
incnt = incnt+n_elem_recv+n_elem_send+3
@ -1171,7 +1251,7 @@ contains
return
end Subroutine psb_cd_get_recv_idx
end Subroutine psb_cd_get_recv_idx_glob
subroutine psb_cd_cnv(desc, mold)
class(psb_desc_type), intent(inout), target :: desc

@ -72,7 +72,8 @@ contains
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m,n,ix,jx,lldx
integer(psb_lpk_), intent(in) :: m,n,ix,jx
integer(psb_ipk_), intent(in) :: lldx
type(psb_desc_type), intent(in) :: desc_dec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional :: iix, jjx
@ -193,7 +194,8 @@ contains
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m,n,ix,jx,lldx
integer(psb_lpk_), intent(in) :: m,n,ix,jx
integer(psb_ipk_), intent(in) :: lldx
type(psb_desc_type), intent(in) :: desc_dec
integer(psb_ipk_), intent(out) :: info

@ -146,7 +146,7 @@ module psi_i_mod
interface psi_bld_tmpovrl
subroutine psi_i_bld_tmpovrl(iv,desc,info)
import
integer(psb_ipk_), intent(in) :: iv(:)
integer(psb_lpk_), intent(in) :: iv(:)
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i_bld_tmpovrl

@ -1,218 +0,0 @@
!
! Parallel Sparse BLAS version 3.5
! (C) Copyright 2006-2018
! Salvatore Filippone
! Alfredo Buttari
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
!
module psb_cd_tools_mod
use psb_const_mod
use psb_desc_mod
use psb_gen_block_map_mod
use psb_list_map_mod
use psb_glist_map_mod
use psb_hash_map_mod
use psb_repl_map_mod
interface psb_cd_set_bld
subroutine psb_cd_set_bld(desc,info)
import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_) :: info
end subroutine psb_cd_set_bld
end interface
interface psb_cd_set_ovl_bld
subroutine psb_cd_set_ovl_bld(desc,info)
import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_) :: info
end subroutine psb_cd_set_ovl_bld
end interface
interface psb_cd_reinit
Subroutine psb_cd_reinit(desc,info)
import :: psb_ipk_, psb_desc_type
Implicit None
! .. Array Arguments ..
Type(psb_desc_type), Intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
end Subroutine psb_cd_reinit
end interface
interface psb_cdcpy
subroutine psb_cdcpy(desc_in, desc_out, info)
import :: psb_ipk_, psb_desc_type
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdcpy
end interface
interface psb_cdprt
subroutine psb_cdprt(iout,desc_p,glob,short,verbosity)
import :: psb_ipk_, psb_desc_type
implicit none
type(psb_desc_type), intent(in) :: desc_p
integer(psb_ipk_), intent(in) :: iout
logical, intent(in), optional :: glob,short
integer(psb_ipk_), intent(in), optional :: verbosity
end subroutine psb_cdprt
end interface
interface psb_cdins
subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
import :: psb_ipk_, psb_lpk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(in) :: nz
integer(psb_lpk_), intent(in) :: ia(:),ja(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:)
end subroutine psb_cdinsrc
subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
import :: psb_ipk_, psb_lpk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(in) :: nz
integer(psb_lpk_), intent(in) :: ja(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(out) :: jla(:)
logical, optional, target, intent(in) :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:)
end subroutine psb_cdinsc
end interface
interface psb_cdbldext
Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype)
import :: psb_ipk_, psb_lpk_, psb_desc_type
Implicit None
Type(psb_desc_type), Intent(inout), target :: desc_a
integer(psb_lpk_), intent(in) :: in_list(:)
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional, target :: mask(:)
integer(psb_ipk_), intent(in),optional :: extype
end Subroutine psb_cd_lstext
end interface
interface psb_cdren
subroutine psb_cdren(trans,iperm,desc_a,info)
import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(inout) :: iperm(:)
character, intent(in) :: trans
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdren
end interface
interface psb_get_overlap
subroutine psb_get_ovrlap(ovrel,desc,info)
import :: psb_ipk_, psb_desc_type
implicit none
integer(psb_ipk_), allocatable, intent(out) :: ovrel(:)
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psb_get_ovrlap
end interface
interface psb_icdasb
subroutine psb_icdasb(desc,info,ext_hv, mold)
import :: psb_ipk_, psb_desc_type, psb_i_base_vect_type
Type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
logical, intent(in),optional :: ext_hv
class(psb_i_base_vect_type), optional, intent(in) :: mold
end subroutine psb_icdasb
end interface
interface psb_cdall
subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,&
& globalcheck,lidx)
import :: psb_ipk_, psb_lpk_, psb_desc_type, psb_parts
implicit None
procedure(psb_parts) :: parts
integer(psb_lpk_), intent(in) :: mg,ng, vl(:)
integer(psb_ipk_), intent(in) :: ictxt, vg(:), lidx(:),nl
integer(psb_ipk_), intent(in) :: flag
logical, intent(in) :: repl, globalcheck
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(out) :: desc
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
end subroutine psb_cdall
end interface
interface psb_cdasb
module procedure psb_cdasb
end interface
interface psb_get_boundary
module procedure psb_get_boundary
end interface
interface
subroutine psb_cd_switch_ovl_indxmap(desc,info)
import :: psb_ipk_, psb_desc_type
implicit None
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cd_switch_ovl_indxmap
end interface
contains
subroutine psb_get_boundary(bndel,desc,info)
use psi_mod, only : psi_crea_bnd_elem
implicit none
integer(psb_ipk_), allocatable, intent(out) :: bndel(:)
type(psb_desc_type), intent(in) :: desc
integer(psb_ipk_), intent(out) :: info
call psi_crea_bnd_elem(bndel,desc,info)
end subroutine psb_get_boundary
subroutine psb_cdasb(desc,info,mold)
Type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type), optional, intent(in) :: mold
call psb_icdasb(desc,info,ext_hv=.false.,mold=mold)
end subroutine psb_cdasb
end module psb_cd_tools_mod

@ -170,187 +170,4 @@ Module psb_i_tools_mod
end interface
interface psb_glob_to_loc
subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:)
integer(psb_ipk_),intent(out) :: y(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: owned
character, intent(in), optional :: iact
end subroutine psb_glob_to_loc2v
subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: owned
character, intent(in), optional :: iact
end subroutine psb_glob_to_loc1v
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x
integer(psb_ipk_),intent(out) :: y
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
logical, intent(in), optional :: owned
end subroutine psb_glob_to_loc2s
subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
logical, intent(in), optional :: owned
end subroutine psb_glob_to_loc1s
end interface
interface psb_loc_to_glob
subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x(:)
integer(psb_ipk_),intent(out) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2v
subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_loc_to_glob1v
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x
integer(psb_ipk_),intent(out) :: y
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_loc_to_glob2s
subroutine psb_loc_to_glob1s(x,desc_a,info,iact)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_loc_to_glob1s
end interface
interface psb_is_owned
module procedure psb_is_owned
end interface
interface psb_is_local
module procedure psb_is_local
end interface
interface psb_owned_index
module procedure psb_owned_index, psb_owned_index_v
end interface
interface psb_local_index
module procedure psb_local_index, psb_local_index_v
end interface
contains
function psb_is_owned(idx,desc)
implicit none
integer(psb_ipk_), intent(in) :: idx
type(psb_desc_type), intent(in) :: desc
logical :: psb_is_owned
logical :: res
integer(psb_ipk_) :: info
call psb_owned_index(res,idx,desc,info)
if (info /= psb_success_) res=.false.
psb_is_owned = res
end function psb_is_owned
function psb_is_local(idx,desc)
implicit none
integer(psb_ipk_), intent(in) :: idx
type(psb_desc_type), intent(in) :: desc
logical :: psb_is_local
logical :: res
integer(psb_ipk_) :: info
call psb_local_index(res,idx,desc,info)
if (info /= psb_success_) res=.false.
psb_is_local = res
end function psb_is_local
subroutine psb_owned_index(res,idx,desc,info)
implicit none
integer(psb_ipk_), intent(in) :: idx
type(psb_desc_type), intent(in) :: desc
logical, intent(out) :: res
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: lx
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.true.)
res = (lx>0)
end subroutine psb_owned_index
subroutine psb_owned_index_v(res,idx,desc,info)
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
type(psb_desc_type), intent(in) :: desc
logical, intent(out) :: res(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), allocatable :: lx(:)
allocate(lx(size(idx)),stat=info)
res=.false.
if (info /= psb_success_) return
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.true.)
res = (lx>0)
end subroutine psb_owned_index_v
subroutine psb_local_index(res,idx,desc,info)
implicit none
integer(psb_ipk_), intent(in) :: idx
type(psb_desc_type), intent(in) :: desc
logical, intent(out) :: res
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: lx
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.false.)
res = (lx>0)
end subroutine psb_local_index
subroutine psb_local_index_v(res,idx,desc,info)
implicit none
integer(psb_ipk_), intent(in) :: idx(:)
type(psb_desc_type), intent(in) :: desc
logical, intent(out) :: res(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), allocatable :: lx(:)
allocate(lx(size(idx)),stat=info)
res=.false.
if (info /= psb_success_) return
call psb_glob_to_loc(idx,lx,desc,info,iact='I',owned=.false.)
res = (lx>0)
end subroutine psb_local_index_v
end module psb_i_tools_mod

@ -61,11 +61,11 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
& loc_col,nprocs,k,glx,nlu,&
& flag_, err_act, novrl, norphan,&
& npr_ov, itmpov, i_pnt
integer(psb_lpk_) :: m, n, nrt
integer(psb_lpk_) :: m, n, nrt, il
integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), &
integer(psb_ipk_), allocatable :: tmpgidx(:,:), &
& nov(:), ov_idx(:,:)
integer(psb_lpk_), allocatable :: vl(:), ix(:)
integer(psb_lpk_), allocatable :: vl(:), ix(:), temp_ovrlap(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt
logical :: check_, islarge
@ -253,7 +253,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
call psb_nullify_desc(desc)
!
! Figure out overlap in the input
! Figure out overlap in the input.
! Note: the code above guarantees that if mpgidx was not allocated,
! then novrl = 0, hence all accesses to tmpgidx
! are safe.
!
if (novrl > 0) then
if (debug_level >= psb_debug_ext_) &
@ -323,8 +326,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
itmpov = 0
if (check_) then
do k=1, loc_row
i = v(k)
nprocs = tmpgidx(i,2)
il = v(k)
nprocs = tmpgidx(il,2)
if (nprocs > 1) then
do
if (j > size(ov_idx,dim=1)) then
@ -335,14 +338,14 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
if (ov_idx(j,1) == i) exit
j = j + 1
end do
call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-ione)
call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1_psb_lpk_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
itmpov = itmpov + 1
temp_ovrlap(itmpov) = i
temp_ovrlap(itmpov) = il
itmpov = itmpov + 1
temp_ovrlap(itmpov) = nprocs
temp_ovrlap(itmpov+1:itmpov+nprocs) = ov_idx(j:j+nprocs-1,2)

@ -45,7 +45,8 @@ Subroutine psb_cd_reinit(desc,info)
! .. Local Scalars ..
integer(psb_ipk_) :: np, me, ictxt
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ext(:), tmp_ovr(:)
integer(psb_ipk_), allocatable :: tmp_halo(:),tmp_ext(:)
integer(psb_lpk_), allocatable :: tmp_ovr(:)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
@ -61,11 +62,11 @@ Subroutine psb_cd_reinit(desc,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),': start'
if (desc%is_asb()) then
call psb_cd_get_recv_idx(tmp_ovr,desc,psb_comm_ovr_,info,toglob=.true.)
call psb_cd_get_recv_idx(tmp_halo,desc,psb_comm_halo_,info,toglob=.false.)
call psb_cd_get_recv_idx(tmp_ext,desc,psb_comm_ext_,info,toglob=.false.)
call psb_cd_get_recv_idx_glob(tmp_ovr,desc,psb_comm_ovr_,info)
call psb_cd_get_recv_idx_loc(tmp_halo,desc,psb_comm_halo_,info)
call psb_cd_get_recv_idx_loc(tmp_ext,desc,psb_comm_ext_,info)
call psb_move_alloc(tmp_ovr,desc%ovrlap_index,info)
call psb_move_alloc(tmp_ovr,desc%tmp_ovrlap_index,info)
call psb_move_alloc(tmp_halo,desc%halo_index,info)
call psb_move_alloc(tmp_ext,desc%ext_index,info)
call desc%indxmap%reinit(info)

@ -46,9 +46,10 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info)
! .. Local Scalars ..
integer(psb_ipk_) :: i, j, np, me, mglob, ictxt, n_row, n_col
integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: err_act
integer(psb_ipk_), allocatable :: vl(:)
integer(psb_lpk_), allocatable :: vl(:)
integer(psb_ipk_) :: debug_level, debug_unit, ierr(5)
integer(psb_mpk_) :: iictxt
character(len=20) :: name, ch_err

@ -63,7 +63,7 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
integer(psb_lpk_) :: iglob
integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_lpk_), allocatable :: loc_idx(:)
integer(psb_ipk_), allocatable :: temp_ovrlap(:)
integer(psb_lpk_), allocatable :: temp_ovrlap(:)
integer(psb_ipk_), allocatable :: prc_v(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_ipk_) :: me, np, nprocs
@ -227,17 +227,17 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info)
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
loc_idx(k) = i
loc_idx(k) = iglob
if (nprocs > 1) then
call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-ione)
call psb_ensure_size((itmpov+3+nprocs),temp_ovrlap,info,pad=-1_psb_lpk_)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_ensure_size')
goto 9999
end if
itmpov = itmpov + 1
temp_ovrlap(itmpov) = i
temp_ovrlap(itmpov) = iglob
itmpov = itmpov + 1
temp_ovrlap(itmpov) = nprocs
temp_ovrlap(itmpov+1:itmpov+nprocs) = prc_v(1:nprocs)

@ -62,7 +62,7 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
& l_ov_ix,l_ov_el,idx, flag_, err_act
integer(psb_lpk_) :: m,n,i
integer(psb_ipk_) :: int_err(5),exch(3)
integer(psb_ipk_), allocatable :: temp_ovrlap(:)
integer(psb_lpk_), allocatable :: temp_ovrlap(:)
integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt
character(len=20) :: name

@ -53,7 +53,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned)
!...parameters....
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: x(:)
integer(psb_lpk_), intent(in) :: x(:)
integer(psb_ipk_), intent(out) :: y(:), info
character, intent(in), optional :: iact
logical, intent(in), optional :: owned
@ -174,7 +174,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned)
!...parameters....
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: owned
character, intent(in), optional :: iact
@ -241,13 +241,14 @@ subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_loc2s
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x
integer(psb_lpk_),intent(in) :: x
integer(psb_ipk_),intent(out) :: y
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
logical, intent(in), optional :: owned
integer(psb_ipk_) :: iv1(1), iv2(1)
integer(psb_lpk_) :: iv1(1)
integer(psb_ipk_) :: iv2(1)
iv1(1) = x
call psb_glob_to_loc(iv1,iv2,desc_a,info,iact,owned)
@ -258,11 +259,11 @@ subroutine psb_glob_to_loc1s(x,desc_a,info,iact,owned)
use psb_base_mod, psb_protect_name => psb_glob_to_loc1s
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x
integer(psb_lpk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
logical, intent(in), optional :: owned
integer(psb_ipk_) :: iv1(1)
integer(psb_lpk_) :: iv1(1)
iv1(1) = x
call psb_glob_to_loc(iv1,desc_a,info,iact,owned)

@ -51,7 +51,7 @@ subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact)
!...parameters....
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: x(:)
integer(psb_ipk_), intent(out) :: y(:)
integer(psb_lpk_), intent(out) :: y(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
@ -156,7 +156,7 @@ subroutine psb_loc_to_glob1v(x,desc_a,info,iact)
!...parameters....
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_lpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
@ -215,11 +215,12 @@ subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(in) :: x
integer(psb_ipk_),intent(out) :: y
integer(psb_lpk_),intent(out) :: y
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
integer(psb_ipk_) :: iv1(1), iv2(1)
integer(psb_ipk_) :: iv1(1)
integer(psb_lpk_) :: iv2(1)
iv1(1) = x
call psb_loc_to_glob(iv1,iv2,desc_a,info,iact)
@ -231,10 +232,10 @@ subroutine psb_loc_to_glob1s(x,desc_a,info,iact)
use psb_tools_mod, psb_protect_name => psb_loc_to_glob1s
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_),intent(inout) :: x
integer(psb_lpk_),intent(inout) :: x
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: iact
integer(psb_ipk_) :: iv1(1)
integer(psb_lpk_) :: iv1(1)
iv1(1) = x
call psb_loc_to_glob(iv1,desc_a,info,iact)

Loading…
Cancel
Save