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

psblas3:

Browse Source 
base/comm/psb_chalo.f90
 base/comm/psb_covrl.f90
 base/comm/psb_igather.f90
 base/comm/psb_ihalo.f90
 base/comm/psb_iovrl.f90
 base/comm/psb_iscatter.F90
 base/comm/psb_zhalo.f90
 base/comm/psb_zovrl.f90

Fix: I comm routines, internal comments in C/Z.
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent 9ac659aab9
commit 41bd66df18
8 changed files with 208 additions and 163 deletions
Show Stats Download Patch File Download Diff File

2
base/comm/psb_chalo.f90
Unescape Escape View File

@ -36,7 +36,7 @@
! distributed dense matrix between all the processes.
!
! Arguments:
! x - real,dimension(:,:). The local part of the dense matrix.
! x - complex,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! alpha - complex(optional). Scale factor.

2
base/comm/psb_covrl.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! info - integer. Return code.
! jx - integer(optional). The starting column of the global matrix
! ik - integer(optional). The number of columns to gather.
! work - real(optional). A work area.
! work - complex(optional). A work area.
! update - integer(optional). Type of update:
! psb_none_ do nothing
! psb_sum_ sum of overlaps

31
base/comm/psb_igather.f90
Unescape Escape View File

@ -35,16 +35,15 @@
! This subroutine gathers pieces of a distributed dense matrix into a local one.
!
! Arguments:
! globx - integer(psb_ipk_),dimension(:,:). The local matrix into which gather
! globx - integer,dimension(:,:). The local matrix into which gather
! the distributed pieces.
! locx - integer(psb_ipk_),dimension(:,:). The local piece of the distributed
! locx - integer,dimension(:,:). The local piece of the distributed
! matrix to be gathered.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code.
! iroot - integer. The process that has to own the
! global matrix. If -1 all
! the processes will have a copy.
! Default: -1.
!
subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
use psb_base_mod, psb_protect_name => psb_igatherm
@ -61,6 +60,7 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx
character(len=20) :: name, ch_err
name='psb_igatherm'
@ -82,7 +82,7 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
root = iroot
if((root < -1).or.(root > np)) then
info=psb_err_input_value_invalid_i_
ierr(1)=5; ierr(2)=root
ierr(1) = 5; ierr(2)=root
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
@ -206,15 +206,16 @@ end subroutine psb_igatherm
! This subroutine gathers pieces of a distributed dense vector into a local one.
!
! Arguments:
! globx - integer(psb_ipk_),dimension(:). The local vector into which gather the
! distributed pieces.
! locx - integer(psb_ipk_),dimension(:). The local piece of the ditributed
! globx - integer,dimension(:). The local vector into which gather
! the distributed pieces.
! locx - integer,dimension(:). The local piece of the distributed
! vector to be gathered.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code.
! iroot - integer. The process that has to own the
! global matrix. If -1 all
! the processes will have a copy.
! default: -1
!
subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
use psb_base_mod, psb_protect_name => psb_igatherv
@ -266,12 +267,12 @@ subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
jlocx=1
ilocx = 1
lda_globx = size(globx)
lda_locx = size(locx)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
lda_globx = m
lda_locx = size(locx)
k = 1
@ -293,6 +294,13 @@ subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
goto 9999
end if
call psb_realloc(m,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
globx(:)=izero
do i=1,desc_a%get_local_rows()
@ -321,6 +329,7 @@ subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
end subroutine psb_igatherv
subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
use psb_base_mod, psb_protect_name => psb_igather_vect
implicit none
@ -339,7 +348,7 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
integer(psb_ipk_), allocatable :: llocx(:)
character(len=20) :: name, ch_err
name='psb_igatherv'
name='psb_cgatherv'
if(psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)

92
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -29,7 +29,6 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_ihalo.f90
!
! Subroutine: psb_ihalom
@ -37,13 +36,13 @@
! distributed dense matrix between all the processes.
!
! Arguments:
! x - integer(psb_ipk_),dimension(:,:). The local part of the dense matrix.
! x - integer,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! alpha - real(optional). Scale factor.
! alpha - integer(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area.
! work - integer(optional). Work area.
! tran - character(optional). Transpose exchange.
! mode - integer(optional). Communication mode (see Swapdata)
! data - integer Which index list in desc_a should be used
@ -63,15 +62,15 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), optional, target, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, k, maxk, liwork,&
& imode, err,data_, ldx
integer(psb_ipk_), pointer :: xp(:,:), iwork(:)
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
& err, liwork,data_, ldx
integer(psb_ipk_),pointer :: iwork(:), xp(:,:)
character :: tran_
character(len=20) :: name, ch_err
logical :: aliw
@ -119,20 +118,17 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
else
tran_ = 'N'
endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
if (present(mode)) then
imode = mode
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
endif
if (present(data)) then
data_ = data
else
data_ = psb_comm_halo_
endif
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@ -151,15 +147,13 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999
! we should write an "iscal"
!!$ if(present(alpha)) then
!!$ if(alpha /= 1.d0) then
!!$ do i=0, k-1
!!$ call iscal(nrow,alpha,x(1,jjx+i),1)
!!$ end do
!!$ end if
!!$ end if
if(present(alpha)) then
if(alpha /= ione) then
do i=0, k-1
call iscal(int(nrow,kind=psb_mpik_),alpha,x(:,jjx+i),1)
end do
end if
end if
liwork=nrow
if (present(work)) then
@ -179,6 +173,7 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
else
aliw=.true.
allocate(iwork(liwork),stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_realloc'
@ -187,14 +182,14 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
end if
xp => x(iix:ldx,jjx:jjx+k-1)
! exchange halo elements
xp => x(iix:size(x,1),jjx:jjx+k-1)
if(tran_ == 'N') then
call psi_swapdata(imode,k,izero,xp,&
& desc_a,iwork,info,data=data_)
else if((tran_ == 'T').or.(tran_ == 'C')) then
call psi_swaptran(imode,k,ione,xp,&
& desc_a,iwork,info)
&desc_a,iwork,info)
else
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='invalid tran')
@ -202,7 +197,8 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='PSI_iSwap...')
ch_err='PSI_cswapdata'
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
goto 9999
end if
@ -251,19 +247,19 @@ end subroutine psb_ihalom
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! Subroutine: psb_ihalov
! This subroutine performs the exchange of the halo elements in a
! distributed dense matrix between all the processes.
! distributed dense vector between all the processes.
!
! Arguments:
! x - integer(psb_ipk_),dimension(:). The local part of the dense matrix.
! x - real,dimension(:). The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! alpha - real(optional). Scale factor.
! alpha - integer(optional). Scale factor.
! jx - integer(optional). The starting column of the global matrix.
! ik - integer(optional). The number of columns to gather.
! work - real(optional). Work area.
! work - integer(optional). Work area.
! tran - character(optional). Transpose exchange.
! mode - integer(optional). Communication mode (see Swapdata)
! data - integer Which index list in desc_a should be used
@ -283,14 +279,14 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: alpha
integer(psb_ipk_), intent(inout), optional, target :: work(:)
integer(psb_ipk_), target, optional, intent(inout) :: work(:)
integer(psb_ipk_), intent(in), optional :: mode,data
character, intent(in), optional :: tran
! locals
integer(psb_ipk_) :: ictxt, np, me,&
& err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
& err, liwork, data_,ldx
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act, ldx, &
& m, n, iix, jjx, ix, ijx, nrow, imode, err, liwork,data_
integer(psb_ipk_),pointer :: iwork(:)
character :: tran_
character(len=20) :: name, ch_err
@ -317,8 +313,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
m = desc_a%get_global_rows()
n = desc_a%get_global_cols()
nrow = desc_a%get_local_rows()
! ncol = desc_a%get_local_cols()
if (present(tran)) then
tran_ = psb_toupper(tran)
@ -335,7 +329,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
else
imode = IOR(psb_swap_send_,psb_swap_recv_)
endif
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@ -354,11 +347,11 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
call psb_errcomm(ictxt,err)
if(err /= 0) goto 9999
!!$ if(present(alpha)) then
!!$ if(alpha /= 1.d0) then
!!$ call dscal(nrow,alpha,x,1)
!!$ end if
!!$ end if
if(present(alpha)) then
if(alpha /= ione) then
call iscal(int(nrow,kind=psb_mpik_),alpha,x,ione)
end if
end if
liwork=nrow
if (present(work)) then
@ -400,7 +393,8 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
end if
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='PSI_iswapdata')
ch_err='PSI_swapdata'
call psb_errpush(psb_err_from_subroutine_,name,a_err=ch_err)
goto 9999
end if
@ -416,8 +410,6 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
end subroutine psb_ihalov
subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
use psb_base_mod, psb_protect_name => psb_ihalo_vect
use psi_mod
@ -502,7 +494,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
if(err /= 0) goto 9999
if(present(alpha)) then
if(alpha /= done) then
if(alpha /= ione) then
call x%scal(alpha)
end if
end if

20
base/comm/psb_iovrl.f90
Unescape Escape View File

@ -29,6 +29,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
!
! File: psb_iovrl.f90
!
! Subroutine: psb_iovrlm
@ -41,7 +42,7 @@
! info - integer. Return code.
! jx - integer(optional). The starting column of the global matrix
! ik - integer(optional). The number of columns to gather.
! work - real(optional). A work area.
! work - integer(optional). A work area.
! update - integer(optional). Type of update:
! psb_none_ do nothing
! psb_sum_ sum of overlaps
@ -75,10 +76,10 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
integer(psb_ipk_), intent(in), optional :: update,jx,ik,mode
! locals
integer(psb_ipk_) :: ictxt, np, me, &
& err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, update_,&
integer(psb_mpik_) :: ictxt, np, me
integer(psb_ipk_) :: err_act, m, n, iix, jjx, ix, ijx, nrow, ncol, k, maxk, update_,&
& mode_, err, liwork, ldx
integer(psb_ipk_), pointer :: iwork(:), xp(:,:)
integer(psb_ipk_),pointer :: iwork(:), xp(:,:)
logical :: do_swap
character(len=20) :: name, ch_err
logical :: aliw
@ -163,6 +164,7 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
else
aliw=.true.
end if
if (aliw) then
allocate(iwork(liwork),stat=info)
if(info /= psb_success_) then
@ -175,7 +177,7 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
end if
! exchange overlap elements
if(do_swap) then
xp => x(iix:size(x,1),jjx:jjx+k-1)
xp => x(iix:ldx,jjx:jjx+k-1)
call psi_swapdata(mode_,k,ione,xp,&
& desc_a,iwork,info,data=psb_comm_ovr_)
end if
@ -195,7 +197,6 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
return
end subroutine psb_iovrlm
!!$
!!$ Parallel Sparse BLAS version 3.4
!!$ (C) Copyright 2006, 2010, 2015
@ -236,7 +237,7 @@ end subroutine psb_iovrlm
! x(:) - integer The local part of the dense vector.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code.
! work - real(optional). A work area.
! work - integer(optional). A work area.
! update - integer(optional). Type of update:
! psb_none_ do nothing
! psb_sum_ sum of overlaps
@ -258,7 +259,6 @@ end subroutine psb_iovrlm
! previous call with swap_send)
!
!
!
subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
use psb_base_mod, psb_protect_name => psb_iovrlv
use psi_mod
@ -316,7 +316,6 @@ subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
mode_ = IOR(psb_swap_send_,psb_swap_recv_)
endif
do_swap = (mode_ /= 0)
ldx = size(x,1)
! check vector correctness
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
@ -359,7 +358,7 @@ subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
! exchange overlap elements
if (do_swap) then
call psi_swapdata(mode_,ione,x(:),&
call psi_swapdata(mode_,ione,x,&
& desc_a,iwork,info,data=psb_comm_ovr_)
end if
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,update_,info)
@ -379,6 +378,7 @@ subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
return
end subroutine psb_iovrlv
subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
use psb_base_mod, psb_protect_name => psb_iovrl_vect
use psi_mod

78
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -36,14 +36,15 @@
! into pieces that are local to alle the processes.
!
! Arguments:
! globx - integer(psb_ipk_),dimension(:,:). The global matrix to scatter.
! locx - integer(psb_ipk_),dimension(:,:). The local piece of the ditributed matrix.
! globx - integer,dimension(:,:). The global matrix to scatter.
! locx - integer,dimension(:,:). The local piece of the distributed matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code.
! iroot - integer(optional). The process that owns the global matrix. If -1 all
! the processes have a copy.
!
! iroot - integer(optional). The process that owns the global matrix.
! If -1 all the processes have a copy.
! Default -1
subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
use psb_base_mod, psb_protect_name => psb_iscatterm
#ifdef MPI_MOD
use mpi
@ -59,12 +60,13 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: iroot
! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, m, n, i, j, idx, nrow, iglobx, jglobx,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, ilx,&
& jlx, c, pos
integer(psb_ipk_), allocatable :: scatterv(:)
integer(psb_ipk_),allocatable :: scatterv(:)
integer(psb_ipk_), allocatable :: displ(:), l_t_g_all(:), all_dim(:), ltg(:)
character(len=20) :: name, ch_err
@ -87,7 +89,7 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
root = iroot
if((root < -1).or.(root > np)) then
info=psb_err_input_value_invalid_i_
ierr(1)=5; ierr(2)= root
ierr(1)=5; ierr(2)=root
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
@ -178,6 +180,15 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
! root has to gather loc_glob from each process
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info)
else
!
! This is to keep debugging compilers from being upset by
! calling an external MPI function with an unallocated array;
! the Fortran side would complain even if the MPI side does
! not use the unallocated stuff.
!
allocate(l_t_g_all(1),scatterv(1),stat=info)
end if
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='Allocate'
@ -185,8 +196,6 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
goto 9999
end if
end if
call mpi_gatherv(ltg,nrow,&
& psb_mpi_ipk_integer,l_t_g_all,all_dim,&
& displ,psb_mpi_ipk_integer,rootrank,icomm,info)
@ -211,7 +220,14 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
end do
if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv)
deallocate(all_dim, l_t_g_all, displ, ltg, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='deallocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
call psb_erractionrestore(err_act)
@ -263,10 +279,10 @@ end subroutine psb_iscatterm
! into pieces that are local to alle the processes.
!
! Arguments:
! globx - integer(psb_ipk_),dimension(:). The global vector to scatter.
! locx - integer(psb_ipk_),dimension(:). The local piece of the ditributed vector.
! globx - integer,dimension(:). The global vector to scatter.
! locx - integer,dimension(:). The local piece of the ditributed vector.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Error code.
! info - integer. Return code
! iroot - integer(optional). The process that owns the global vector. If -1 all
! the processes have a copy.
!
@ -317,7 +333,7 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
root = iroot
if((root < -1).or.(root > np)) then
info=psb_err_input_value_invalid_i_
ierr(1) = 5; ierr(2) = root
ierr(1) = 5; ierr(2)=root
call psb_errpush(info,name,i_err=ierr)
goto 9999
end if
@ -369,7 +385,14 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
call psb_get_rank(rootrank,ictxt,root)
! root has to gather size information
allocate(displ(np),all_dim(np),ltg(nrow))
allocate(displ(np),all_dim(np),ltg(nrow),stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='Allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
do i=1, nrow
ltg(i) = i
end do
@ -390,7 +413,22 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
endif
! root has to gather loc_glob from each process
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)))
allocate(l_t_g_all(sum(all_dim)),scatterv(sum(all_dim)),stat=info)
else
!
! This is to keep debugging compilers from being upset by
! calling an external MPI function with an unallocated array;
! the Fortran side would complain even if the MPI side does
! not use the unallocated stuff.
!
allocate(l_t_g_all(1),scatterv(1),stat=info)
end if
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='Allocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
call mpi_gatherv(ltg,nrow,&
@ -413,7 +451,13 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
& psb_mpi_ipk_integer,locx,nrow,&
& psb_mpi_ipk_integer,rootrank,icomm,info)
if (me == root) deallocate(all_dim, l_t_g_all, displ, scatterv)
deallocate(all_dim, l_t_g_all, displ, ltg, scatterv,stat=info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='deallocate'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
call psb_erractionrestore(err_act)

2
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -36,7 +36,7 @@
! distributed dense matrix between all the processes.
!
! Arguments:
! x - real,dimension(:,:). The local part of the dense matrix.
! x - complex,dimension(:,:). The local part of the dense matrix.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
! alpha - complex(optional). Scale factor.

2
base/comm/psb_zovrl.f90
Unescape Escape View File

@ -42,7 +42,7 @@
! info - integer. Return code.
! jx - integer(optional). The starting column of the global matrix
! ik - integer(optional). The number of columns to gather.
! work - real(optional). A work area.
! work - complex(optional). A work area.
! update - integer(optional). Type of update:
! psb_none_ do nothing
! psb_sum_ sum of overlaps

Write Preview
Loading…
Cancel
Save