fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Round of fixes for matrix remote build. Something still wrong.

Browse Source
This commit is contained in:
Salvatore Filippone
2022-02-04 19:12:32 +01:00
parent 6d0b26ecf1
commit 0b19adab3c
18 changed files with 464 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/tools/psb_c_remote_mat.F90
+84 -63
View File
@@ -98,20 +98,19 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
integer(psb_ipk_) :: nnp, nrcvs, nsnds
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_), allocatable :: brvindx(:), &
& rvsz(:), bsdindx(:),sdsz(:)
& rvsz(:), bsdindx(:),sdsz(:), sdsi(:), rvsi(:)
integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:)
complex(psb_spk_), allocatable :: valsnd(:)
type(psb_lc_coo_sparse_mat), allocatable :: acoo
integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:), ladj(:), ila(:), iprc(:)
integer(psb_ipk_), allocatable :: ladj(:), ila(:), iprc(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit, err_act
character(len=20) :: name, ch_err
info=psb_success_
name='psb_csphalo'
name='psb_c_remote_mat'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
@@ -129,9 +128,9 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
call b%free()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
Allocate(rvsz(np),sdsz(np),sdsi(np),rvsi(np),brvindx(np+1),&
& bsdindx(np+1), acoo,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@@ -140,71 +139,94 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
end if
nz = a%get_nzeros()
allocate(ila(nz))
write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
write(0,*) me,name,' Processes:',ladj(1:nnp)
nz = a%get_nzeros()
allocate(ila(nz))
!write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
!write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
icomm = desc_a%get_mpic()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), stat=info)
sdsz(:)=0
rvsz(:)=0
ipx = 1
brvindx(ipx) = 0
bsdindx(ipx) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
!write(0,*) me,name,' Processes:',ladj(1:nnp)
lnnz = max(iszr,iszs,lone)
lnc = a%get_ncols()
call acoo%allocate(lnr,lnc,lnnz)
icomm = desc_a%get_mpic()
sdsz(:)=0
rvsz(:)=0
sdsi(:)=0
rvsi(:)=0
ipx = 1
brvindx(:) = 0
bsdindx(:) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
!write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
Do proc=0,np-1
bsdindx(proc+1) = idxs
idxs = idxs + sdsz(proc+1)
brvindx(proc+1) = idxr
idxr = idxr + rvsz(proc+1)
Enddo
iszs = sum(sdsz)
iszr = sum(rvsz)
call acoo%allocate(desc_a%get_global_rows(),desc_a%get_global_cols(),iszr)
if (psb_errstatus_fatal()) then
write(0,*) 'Error from acoo%allocate '
info = 4010
goto 9999
end if
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
!write(debug_unit,*) me,' ',trim(name),': ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
!write(debug_unit,*) me,' ',trim(name),' iasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
!write(debug_unit,*) me,' ',trim(name),' jasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
!write(debug_unit,*) me,' ',trim(name),' valsnd: ',info
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
do k=1, nz
proc = iprc(k)
sdsi(proc+1) = sdsi(proc+1) + 1
!rvsi(proc) = rvsi(proc) + 1
iasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ia(k)
jasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ja(k)
valsnd(bsdindx(proc+1)+sdsi(proc+1)) = a%val(k)
end do
do proc=0,np-1
if (sdsi(proc+1) /= sdsz(proc+1)) &
& write(0,*) me,name,'Send mismacth ',sdsi(proc+1),sdsz(proc+1)
end do
select case(psb_get_sp_a2av_alg())
case(psb_sp_a2av_smpl_triad_)
@@ -218,7 +240,7 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,ctxt,info)
case(psb_sp_a2av_mpi_)
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_spk_,&
& acoo%val,rvsz,brvindx,psb_mpi_c_spk_,icomm,minfo)
if (minfo == mpi_success) &
@@ -239,10 +261,9 @@ Subroutine psb_lc_remote_mat(a,desc_a,b,info)
call psb_errpush(info,name,a_err='alltoallv')
goto 9999
end if
call acoo%set_nzeros(iszr)
call acoo%mv_to_coo(b,info)
Deallocate(brvindx,bsdindx,rvsz,sdsz,&
& iasnd,jasnd,valsnd,stat=info)
if (debug_level >= psb_debug_outer_)&
base/tools/psb_cspalloc.f90
+4 -4
View File
@@ -114,16 +114,16 @@ subroutine psb_cspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
write(0,*) name,'Setting a%remote_build ',&
& bldmode_,psb_matbld_noremote_,psb_matbld_remote_
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
a%remote_build = bldmode_
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
write(0,*) name,' matbld_noremote_ nothing needed'
!write(0,*) name,' matbld_noremote_ nothing needed'
case (psb_matbld_remote_)
write(0,*) name,' matbld_remote_ start '
!write(0,*) name,' matbld_remote_ start '
allocate(a%rmta)
nnzrmt_ = max(100,(nnz_/100))
call a%rmta%allocate(m,n,nnzrmt_)
base/tools/psb_cspasb.f90
+24 -12
View File
@@ -106,26 +106,38 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold)
! First case: we come from a fresh build.
!
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
if (a%is_bld()) then
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
case (psb_matbld_remote_)
write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
block
type(psb_lc_coo_sparse_mat) :: a_add
integer(psb_ipk_), allocatable :: ila(:), jla(:)
integer(psb_ipk_) :: nz, nzt,k
call psb_remote_mat(a%rmta,desc_a,a_add,info)
end block
nz = a_add%get_nzeros()
!!$ write(0,*) me,name,' Nz to be added',nz
nzt = nz
call psb_sum(ctxt,nzt)
if (nzt>0) call psb_cd_reinit(desc_a, info)
if (nz > 0) then
!
! Should we check for new indices here?
!
call psb_realloc(nz,ila,info)
call psb_realloc(nz,jla,info)
call desc_a%indxmap%g2l(a_add%ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == 0) call desc_a%indxmap%g2l_ins(a_add%ja(1:nz),jla(1:nz),info)
!write(0,*) me,name,' Check before insert',a%get_nzeros()
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%csput(nz,ila,jla,a_add%val,ione,n_row,ione,n_col,info)
!write(0,*) me,name,' Check after insert',a%get_nzeros(),nz
end if
if (nzt > 0) call psb_cdasb(desc_a,info)
end block
end select
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
base/tools/psb_cspins.F90
+3 -3
View File
@@ -164,9 +164,9 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
do i=1,nz
if (ila(i)<0) then
k=k+1
lila(k) = ia(k)
ljla(k) = ja(k)
lval(k) = val(k)
lila(k) = ia(i)
ljla(k) = ja(i)
lval(k) = val(i)
end if
end do
if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl
base/tools/psb_d_remote_mat.F90
+84 -63
View File
@@ -98,20 +98,19 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
integer(psb_ipk_) :: nnp, nrcvs, nsnds
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_), allocatable :: brvindx(:), &
& rvsz(:), bsdindx(:),sdsz(:)
& rvsz(:), bsdindx(:),sdsz(:), sdsi(:), rvsi(:)
integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:)
real(psb_dpk_), allocatable :: valsnd(:)
type(psb_ld_coo_sparse_mat), allocatable :: acoo
integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:), ladj(:), ila(:), iprc(:)
integer(psb_ipk_), allocatable :: ladj(:), ila(:), iprc(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit, err_act
character(len=20) :: name, ch_err
info=psb_success_
name='psb_dsphalo'
name='psb_d_remote_mat'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
@@ -129,9 +128,9 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
call b%free()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
Allocate(rvsz(np),sdsz(np),sdsi(np),rvsi(np),brvindx(np+1),&
& bsdindx(np+1), acoo,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@@ -140,71 +139,94 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
end if
nz = a%get_nzeros()
allocate(ila(nz))
write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
write(0,*) me,name,' Processes:',ladj(1:nnp)
nz = a%get_nzeros()
allocate(ila(nz))
!write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
!write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
icomm = desc_a%get_mpic()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), stat=info)
sdsz(:)=0
rvsz(:)=0
ipx = 1
brvindx(ipx) = 0
bsdindx(ipx) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
!write(0,*) me,name,' Processes:',ladj(1:nnp)
lnnz = max(iszr,iszs,lone)
lnc = a%get_ncols()
call acoo%allocate(lnr,lnc,lnnz)
icomm = desc_a%get_mpic()
sdsz(:)=0
rvsz(:)=0
sdsi(:)=0
rvsi(:)=0
ipx = 1
brvindx(:) = 0
bsdindx(:) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
!write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
Do proc=0,np-1
bsdindx(proc+1) = idxs
idxs = idxs + sdsz(proc+1)
brvindx(proc+1) = idxr
idxr = idxr + rvsz(proc+1)
Enddo
iszs = sum(sdsz)
iszr = sum(rvsz)
call acoo%allocate(desc_a%get_global_rows(),desc_a%get_global_cols(),iszr)
if (psb_errstatus_fatal()) then
write(0,*) 'Error from acoo%allocate '
info = 4010
goto 9999
end if
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
!write(debug_unit,*) me,' ',trim(name),': ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
!write(debug_unit,*) me,' ',trim(name),' iasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
!write(debug_unit,*) me,' ',trim(name),' jasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
!write(debug_unit,*) me,' ',trim(name),' valsnd: ',info
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
do k=1, nz
proc = iprc(k)
sdsi(proc+1) = sdsi(proc+1) + 1
!rvsi(proc) = rvsi(proc) + 1
iasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ia(k)
jasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ja(k)
valsnd(bsdindx(proc+1)+sdsi(proc+1)) = a%val(k)
end do
do proc=0,np-1
if (sdsi(proc+1) /= sdsz(proc+1)) &
& write(0,*) me,name,'Send mismacth ',sdsi(proc+1),sdsz(proc+1)
end do
select case(psb_get_sp_a2av_alg())
case(psb_sp_a2av_smpl_triad_)
@@ -218,7 +240,7 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,ctxt,info)
case(psb_sp_a2av_mpi_)
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_dpk_,&
& acoo%val,rvsz,brvindx,psb_mpi_r_dpk_,icomm,minfo)
if (minfo == mpi_success) &
@@ -239,10 +261,9 @@ Subroutine psb_ld_remote_mat(a,desc_a,b,info)
call psb_errpush(info,name,a_err='alltoallv')
goto 9999
end if
call acoo%set_nzeros(iszr)
call acoo%mv_to_coo(b,info)
Deallocate(brvindx,bsdindx,rvsz,sdsz,&
& iasnd,jasnd,valsnd,stat=info)
if (debug_level >= psb_debug_outer_)&
base/tools/psb_dspalloc.f90
+4 -4
View File
@@ -114,16 +114,16 @@ subroutine psb_dspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
write(0,*) name,'Setting a%remote_build ',&
& bldmode_,psb_matbld_noremote_,psb_matbld_remote_
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
a%remote_build = bldmode_
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
write(0,*) name,' matbld_noremote_ nothing needed'
!write(0,*) name,' matbld_noremote_ nothing needed'
case (psb_matbld_remote_)
write(0,*) name,' matbld_remote_ start '
!write(0,*) name,' matbld_remote_ start '
allocate(a%rmta)
nnzrmt_ = max(100,(nnz_/100))
call a%rmta%allocate(m,n,nnzrmt_)
base/tools/psb_dspasb.f90
+24 -12
View File
@@ -106,26 +106,38 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold)
! First case: we come from a fresh build.
!
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
if (a%is_bld()) then
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
case (psb_matbld_remote_)
write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
block
type(psb_ld_coo_sparse_mat) :: a_add
integer(psb_ipk_), allocatable :: ila(:), jla(:)
integer(psb_ipk_) :: nz, nzt,k
call psb_remote_mat(a%rmta,desc_a,a_add,info)
end block
nz = a_add%get_nzeros()
!!$ write(0,*) me,name,' Nz to be added',nz
nzt = nz
call psb_sum(ctxt,nzt)
if (nzt>0) call psb_cd_reinit(desc_a, info)
if (nz > 0) then
!
! Should we check for new indices here?
!
call psb_realloc(nz,ila,info)
call psb_realloc(nz,jla,info)
call desc_a%indxmap%g2l(a_add%ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == 0) call desc_a%indxmap%g2l_ins(a_add%ja(1:nz),jla(1:nz),info)
!write(0,*) me,name,' Check before insert',a%get_nzeros()
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%csput(nz,ila,jla,a_add%val,ione,n_row,ione,n_col,info)
!write(0,*) me,name,' Check after insert',a%get_nzeros(),nz
end if
if (nzt > 0) call psb_cdasb(desc_a,info)
end block
end select
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
base/tools/psb_dspins.F90
+3 -3
View File
@@ -164,9 +164,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
do i=1,nz
if (ila(i)<0) then
k=k+1
lila(k) = ia(k)
ljla(k) = ja(k)
lval(k) = val(k)
lila(k) = ia(i)
ljla(k) = ja(i)
lval(k) = val(i)
end if
end do
if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl
base/tools/psb_s_remote_mat.F90
+84 -63
View File
@@ -98,20 +98,19 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
integer(psb_ipk_) :: nnp, nrcvs, nsnds
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_), allocatable :: brvindx(:), &
& rvsz(:), bsdindx(:),sdsz(:)
& rvsz(:), bsdindx(:),sdsz(:), sdsi(:), rvsi(:)
integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:)
real(psb_spk_), allocatable :: valsnd(:)
type(psb_ls_coo_sparse_mat), allocatable :: acoo
integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:), ladj(:), ila(:), iprc(:)
integer(psb_ipk_), allocatable :: ladj(:), ila(:), iprc(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit, err_act
character(len=20) :: name, ch_err
info=psb_success_
name='psb_ssphalo'
name='psb_s_remote_mat'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
@@ -129,9 +128,9 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
call b%free()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
Allocate(rvsz(np),sdsz(np),sdsi(np),rvsi(np),brvindx(np+1),&
& bsdindx(np+1), acoo,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@@ -140,71 +139,94 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
end if
nz = a%get_nzeros()
allocate(ila(nz))
write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
write(0,*) me,name,' Processes:',ladj(1:nnp)
nz = a%get_nzeros()
allocate(ila(nz))
!write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
!write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
icomm = desc_a%get_mpic()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), stat=info)
sdsz(:)=0
rvsz(:)=0
ipx = 1
brvindx(ipx) = 0
bsdindx(ipx) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
!write(0,*) me,name,' Processes:',ladj(1:nnp)
lnnz = max(iszr,iszs,lone)
lnc = a%get_ncols()
call acoo%allocate(lnr,lnc,lnnz)
icomm = desc_a%get_mpic()
sdsz(:)=0
rvsz(:)=0
sdsi(:)=0
rvsi(:)=0
ipx = 1
brvindx(:) = 0
bsdindx(:) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
!write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
Do proc=0,np-1
bsdindx(proc+1) = idxs
idxs = idxs + sdsz(proc+1)
brvindx(proc+1) = idxr
idxr = idxr + rvsz(proc+1)
Enddo
iszs = sum(sdsz)
iszr = sum(rvsz)
call acoo%allocate(desc_a%get_global_rows(),desc_a%get_global_cols(),iszr)
if (psb_errstatus_fatal()) then
write(0,*) 'Error from acoo%allocate '
info = 4010
goto 9999
end if
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
!write(debug_unit,*) me,' ',trim(name),': ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
!write(debug_unit,*) me,' ',trim(name),' iasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
!write(debug_unit,*) me,' ',trim(name),' jasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
!write(debug_unit,*) me,' ',trim(name),' valsnd: ',info
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
do k=1, nz
proc = iprc(k)
sdsi(proc+1) = sdsi(proc+1) + 1
!rvsi(proc) = rvsi(proc) + 1
iasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ia(k)
jasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ja(k)
valsnd(bsdindx(proc+1)+sdsi(proc+1)) = a%val(k)
end do
do proc=0,np-1
if (sdsi(proc+1) /= sdsz(proc+1)) &
& write(0,*) me,name,'Send mismacth ',sdsi(proc+1),sdsz(proc+1)
end do
select case(psb_get_sp_a2av_alg())
case(psb_sp_a2av_smpl_triad_)
@@ -218,7 +240,7 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,ctxt,info)
case(psb_sp_a2av_mpi_)
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_r_spk_,&
& acoo%val,rvsz,brvindx,psb_mpi_r_spk_,icomm,minfo)
if (minfo == mpi_success) &
@@ -239,10 +261,9 @@ Subroutine psb_ls_remote_mat(a,desc_a,b,info)
call psb_errpush(info,name,a_err='alltoallv')
goto 9999
end if
call acoo%set_nzeros(iszr)
call acoo%mv_to_coo(b,info)
Deallocate(brvindx,bsdindx,rvsz,sdsz,&
& iasnd,jasnd,valsnd,stat=info)
if (debug_level >= psb_debug_outer_)&
base/tools/psb_sspalloc.f90
+4 -4
View File
@@ -114,16 +114,16 @@ subroutine psb_sspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
write(0,*) name,'Setting a%remote_build ',&
& bldmode_,psb_matbld_noremote_,psb_matbld_remote_
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
a%remote_build = bldmode_
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
write(0,*) name,' matbld_noremote_ nothing needed'
!write(0,*) name,' matbld_noremote_ nothing needed'
case (psb_matbld_remote_)
write(0,*) name,' matbld_remote_ start '
!write(0,*) name,' matbld_remote_ start '
allocate(a%rmta)
nnzrmt_ = max(100,(nnz_/100))
call a%rmta%allocate(m,n,nnzrmt_)
base/tools/psb_sspasb.f90
+24 -12
View File
@@ -106,26 +106,38 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold)
! First case: we come from a fresh build.
!
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
if (a%is_bld()) then
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
case (psb_matbld_remote_)
write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
block
type(psb_ls_coo_sparse_mat) :: a_add
integer(psb_ipk_), allocatable :: ila(:), jla(:)
integer(psb_ipk_) :: nz, nzt,k
call psb_remote_mat(a%rmta,desc_a,a_add,info)
end block
nz = a_add%get_nzeros()
!!$ write(0,*) me,name,' Nz to be added',nz
nzt = nz
call psb_sum(ctxt,nzt)
if (nzt>0) call psb_cd_reinit(desc_a, info)
if (nz > 0) then
!
! Should we check for new indices here?
!
call psb_realloc(nz,ila,info)
call psb_realloc(nz,jla,info)
call desc_a%indxmap%g2l(a_add%ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == 0) call desc_a%indxmap%g2l_ins(a_add%ja(1:nz),jla(1:nz),info)
!write(0,*) me,name,' Check before insert',a%get_nzeros()
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%csput(nz,ila,jla,a_add%val,ione,n_row,ione,n_col,info)
!write(0,*) me,name,' Check after insert',a%get_nzeros(),nz
end if
if (nzt > 0) call psb_cdasb(desc_a,info)
end block
end select
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
base/tools/psb_sspins.F90
+3 -3
View File
@@ -164,9 +164,9 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
do i=1,nz
if (ila(i)<0) then
k=k+1
lila(k) = ia(k)
ljla(k) = ja(k)
lval(k) = val(k)
lila(k) = ia(i)
ljla(k) = ja(i)
lval(k) = val(i)
end if
end do
if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl
base/tools/psb_z_remote_mat.F90
+84 -63
View File
@@ -98,20 +98,19 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
integer(psb_ipk_) :: nnp, nrcvs, nsnds
integer(psb_mpk_) :: icomm, minfo
integer(psb_mpk_), allocatable :: brvindx(:), &
& rvsz(:), bsdindx(:),sdsz(:)
& rvsz(:), bsdindx(:),sdsz(:), sdsi(:), rvsi(:)
integer(psb_lpk_), allocatable :: iasnd(:), jasnd(:)
complex(psb_dpk_), allocatable :: valsnd(:)
type(psb_lz_coo_sparse_mat), allocatable :: acoo
integer(psb_ipk_), pointer :: idxv(:)
class(psb_i_base_vect_type), pointer :: pdxv
integer(psb_ipk_), allocatable :: ipdxv(:), ladj(:), ila(:), iprc(:)
integer(psb_ipk_), allocatable :: ladj(:), ila(:), iprc(:)
logical :: rowcnv_,colcnv_,rowscale_,colscale_
character(len=5) :: outfmt_
integer(psb_ipk_) :: debug_level, debug_unit, err_act
character(len=20) :: name, ch_err
info=psb_success_
name='psb_zsphalo'
name='psb_z_remote_mat'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
@@ -129,9 +128,9 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
call b%free()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), acoo,stat=info)
Allocate(rvsz(np),sdsz(np),sdsi(np),rvsi(np),brvindx(np+1),&
& bsdindx(np+1), acoo,stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@@ -140,71 +139,94 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
end if
nz = a%get_nzeros()
allocate(ila(nz))
write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
write(0,*) me,name,' Processes:',ladj(1:nnp)
nz = a%get_nzeros()
allocate(ila(nz))
!write(0,*) me,name,' size :',nz,size(ila)
call desc_a%g2l(a%ia(1:nz),ila(1:nz),info,owned=.false.)
nouth = count(ila(1:nz)<0)
!write(0,*) me,name,' Count out of halo :',nouth
call psb_max(ctxt,nouth)
if ((nouth/=0).and.(me==0)) &
& write(0,*) 'Warning: would require reinit of DESC_A'
icomm = desc_a%get_mpic()
Allocate(brvindx(np+1),&
& rvsz(np),sdsz(np),bsdindx(np+1), stat=info)
sdsz(:)=0
rvsz(:)=0
ipx = 1
brvindx(ipx) = 0
bsdindx(ipx) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
call psi_graph_fnd_owner(a%ia(1:nz),iprc,ladj,desc_a%indxmap,info)
call psb_msort_unique(ladj,nnp)
!write(0,*) me,name,' Processes:',ladj(1:nnp)
lnnz = max(iszr,iszs,lone)
lnc = a%get_ncols()
call acoo%allocate(lnr,lnc,lnnz)
icomm = desc_a%get_mpic()
sdsz(:)=0
rvsz(:)=0
sdsi(:)=0
rvsi(:)=0
ipx = 1
brvindx(:) = 0
bsdindx(:) = 0
counter=1
idx = 0
idxs = 0
idxr = 0
do i=1,nz
if (iprc(i) >=0) then
sdsz(iprc(i)+1) = sdsz(iprc(i)+1) +1
else
write(0,*)me,name,' Error from fnd_owner: ',iprc(i)
end if
end do
call mpi_alltoall(sdsz,1,psb_mpi_mpk_,&
& rvsz,1,psb_mpi_mpk_,icomm,minfo)
if (minfo /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='mpi_alltoall')
goto 9999
end if
!write(0,*)me,name,' sdsz ',sdsz(:),' rvsz:',rvsz(:)
nsnds = count(sdsz /= 0)
nrcvs = count(rvsz /= 0)
idxs = 0
idxr = 0
counter = 1
Do proc=0,np-1
bsdindx(proc+1) = idxs
idxs = idxs + sdsz(proc+1)
brvindx(proc+1) = idxr
idxr = idxr + rvsz(proc+1)
Enddo
iszs = sum(sdsz)
iszr = sum(rvsz)
call acoo%allocate(desc_a%get_global_rows(),desc_a%get_global_cols(),iszr)
if (psb_errstatus_fatal()) then
write(0,*) 'Error from acoo%allocate '
info = 4010
goto 9999
end if
if (debug_level >= psb_debug_outer_)&
& write(debug_unit,*) me,' ',trim(name),': Sizes:',acoo%get_size(),&
& ' Send:',sdsz(:),' Receive:',rvsz(:)
!write(debug_unit,*) me,' ',trim(name),': ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),iasnd,info)
!write(debug_unit,*) me,' ',trim(name),' iasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),jasnd,info)
!write(debug_unit,*) me,' ',trim(name),' jasnd: ',info
if (info == psb_success_) call psb_ensure_size(max(iszs,1),valsnd,info)
!write(debug_unit,*) me,' ',trim(name),' valsnd: ',info
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='ensure_size')
goto 9999
end if
do k=1, nz
proc = iprc(k)
sdsi(proc+1) = sdsi(proc+1) + 1
!rvsi(proc) = rvsi(proc) + 1
iasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ia(k)
jasnd(bsdindx(proc+1)+sdsi(proc+1)) = a%ja(k)
valsnd(bsdindx(proc+1)+sdsi(proc+1)) = a%val(k)
end do
do proc=0,np-1
if (sdsi(proc+1) /= sdsz(proc+1)) &
& write(0,*) me,name,'Send mismacth ',sdsi(proc+1),sdsz(proc+1)
end do
select case(psb_get_sp_a2av_alg())
case(psb_sp_a2av_smpl_triad_)
@@ -218,7 +240,7 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
if (info == psb_success_) call psb_simple_a2av(jasnd,sdsz,bsdindx,&
& acoo%ja,rvsz,brvindx,ctxt,info)
case(psb_sp_a2av_mpi_)
call mpi_alltoallv(valsnd,sdsz,bsdindx,psb_mpi_c_dpk_,&
& acoo%val,rvsz,brvindx,psb_mpi_c_dpk_,icomm,minfo)
if (minfo == mpi_success) &
@@ -239,10 +261,9 @@ Subroutine psb_lz_remote_mat(a,desc_a,b,info)
call psb_errpush(info,name,a_err='alltoallv')
goto 9999
end if
call acoo%set_nzeros(iszr)
call acoo%mv_to_coo(b,info)
Deallocate(brvindx,bsdindx,rvsz,sdsz,&
& iasnd,jasnd,valsnd,stat=info)
if (debug_level >= psb_debug_outer_)&
base/tools/psb_zspalloc.f90
+4 -4
View File
@@ -114,16 +114,16 @@ subroutine psb_zspalloc(a, desc_a, info, nnz, bldmode)
goto 9999
end if
write(0,*) name,'Setting a%remote_build ',&
& bldmode_,psb_matbld_noremote_,psb_matbld_remote_
!!$ write(0,*) name,'Setting a%remote_build ',&
!!$ & bldmode_,psb_matbld_noremote_,psb_matbld_remote_
a%remote_build = bldmode_
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
write(0,*) name,' matbld_noremote_ nothing needed'
!write(0,*) name,' matbld_noremote_ nothing needed'
case (psb_matbld_remote_)
write(0,*) name,' matbld_remote_ start '
!write(0,*) name,' matbld_remote_ start '
allocate(a%rmta)
nnzrmt_ = max(100,(nnz_/100))
call a%rmta%allocate(m,n,nnzrmt_)
base/tools/psb_zspasb.f90
+24 -12
View File
@@ -106,26 +106,38 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold)
! First case: we come from a fresh build.
!
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%set_nrows(n_row)
call a%set_ncols(n_col)
end if
if (a%is_bld()) then
select case(a%remote_build)
case (psb_matbld_noremote_)
! nothing needed
case (psb_matbld_remote_)
write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
!write(0,*) me,name,' Size of rmta:',a%rmta%get_nzeros()
block
type(psb_lz_coo_sparse_mat) :: a_add
integer(psb_ipk_), allocatable :: ila(:), jla(:)
integer(psb_ipk_) :: nz, nzt,k
call psb_remote_mat(a%rmta,desc_a,a_add,info)
end block
nz = a_add%get_nzeros()
!!$ write(0,*) me,name,' Nz to be added',nz
nzt = nz
call psb_sum(ctxt,nzt)
if (nzt>0) call psb_cd_reinit(desc_a, info)
if (nz > 0) then
!
! Should we check for new indices here?
!
call psb_realloc(nz,ila,info)
call psb_realloc(nz,jla,info)
call desc_a%indxmap%g2l(a_add%ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == 0) call desc_a%indxmap%g2l_ins(a_add%ja(1:nz),jla(1:nz),info)
!write(0,*) me,name,' Check before insert',a%get_nzeros()
n_row = desc_a%get_local_rows()
n_col = desc_a%get_local_cols()
call a%csput(nz,ila,jla,a_add%val,ione,n_row,ione,n_col,info)
!write(0,*) me,name,' Check after insert',a%get_nzeros(),nz
end if
if (nzt > 0) call psb_cdasb(desc_a,info)
end block
end select
call a%cscnv(info,type=afmt,dupl=dupl, mold=mold)
base/tools/psb_zspins.F90
+3 -3
View File
@@ -164,9 +164,9 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
do i=1,nz
if (ila(i)<0) then
k=k+1
lila(k) = ia(k)
ljla(k) = ja(k)
lval(k) = val(k)
lila(k) = ia(i)
ljla(k) = ja(i)
lval(k) = val(i)
end if
end do
if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl
test/pargen/psb_d_pde3d.F90
+2 -2
View File
@@ -679,9 +679,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
test/pargen/psb_s_pde3d.F90
+2 -2
View File
@@ -679,9 +679,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,dupl=psb_dupl_add_,afmt=afmt)
end if
end if
call psb_barrier(ctxt)