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_cspgather.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zspgather.F90

Was missing loc_to_glob on gather.
psblas-3.0-maint
Salvatore Filippone 13 years ago
parent 6b12d0b3d8
commit 7674f6a831
4 changed files with 60 additions and 36 deletions
Show Stats Download Patch File Download Diff File

20
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -1,8 +1,9 @@
subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod
use psb_mat_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -20,7 +21,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -59,9 +60,18 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo) call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = loc_coo%get_nzeros() nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -86,11 +96,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%mv_from(loc_coo)
else
call loc_coo%free() call loc_coo%free()
end if
call glob_coo%set_nzeros(nzg) call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo) call globa%mv_from(glob_coo)

20
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -1,8 +1,9 @@
subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod
use psb_mat_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -20,7 +21,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -59,9 +60,18 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo) call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = loc_coo%get_nzeros() nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -86,11 +96,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%mv_from(loc_coo)
else
call loc_coo%free() call loc_coo%free()
end if
call glob_coo%set_nzeros(nzg) call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo) call globa%mv_from(glob_coo)

20
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -1,8 +1,9 @@
subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod
use psb_mat_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -20,7 +21,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -59,9 +60,18 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo) call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = loc_coo%get_nzeros() nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -86,11 +96,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%mv_from(loc_coo)
else
call loc_coo%free() call loc_coo%free()
end if
call glob_coo%set_nzeros(nzg) call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo) call globa%mv_from(glob_coo)

20
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -1,8 +1,9 @@
subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_descriptor_type use psb_descriptor_type
use psb_error_mod use psb_error_mod
use psb_mat_mod
use psb_penv_mod use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD #ifdef MPI_MOD
use mpi use mpi
#endif #endif
@ -20,7 +21,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_mpik_) :: ictxt,np,me, icomm, minfo integer(psb_mpik_) :: ictxt,np,me, icomm, minfo
integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_, nrg, ncg, nzg
integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k integer(psb_ipk_) :: ip, ndx,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_ logical :: keepnum_, keeploc_
integer(psb_mpik_), allocatable :: nzbr(:), idisp(:) integer(psb_mpik_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -59,9 +60,18 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
call psb_errpush(info,name,i_err=ierr,a_err='integer') call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo) call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0 nzbr(:) = 0
nzbr(me+1) = loc_coo%get_nzeros() nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np)) call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr) nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
@ -86,11 +96,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
goto 9999 goto 9999
end if end if
if (keeploc_) then
call loca%mv_from(loc_coo)
else
call loc_coo%free() call loc_coo%free()
end if
call glob_coo%set_nzeros(nzg) call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl) if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo) call globa%mv_from(glob_coo)

Write Preview
Loading…
Cancel
Save