diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index 0c2ade2d..747d1427 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -117,7 +117,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, dupl, mold) case (psb_matbld_noremote_) ! nothing needed case (psb_matbld_remote_) - write(0,*) 'Need to implement data movement! ' + write(0,*) me,' Size of rmta:',a%rmta%get_nzeros() end select call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) diff --git a/base/tools/psb_cspins.F90 b/base/tools/psb_cspins.F90 index 0084aa7d..2961c646 100644 --- a/base/tools/psb_cspins.F90 +++ b/base/tools/psb_cspins.F90 @@ -157,20 +157,22 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ! Do nothing case (psb_matbld_remote_) nnl = count(ila(1:nz)<0) - allocate(lila(nnl),ljla(nnl),lval(nnl)) - k = 0 - do i=1,nz - if (ila(i)<0) then - k=k+1 - lila(k) = ia(k) - ljla(k) = ja(k) - lval(k) = val(k) - end if - end do - if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl - call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& - & 1_psb_lpk_,desc_a%get_global_rows(),info) - + if (nnl > 0) then + write(0,*) 'Check on insert ',nnl + allocate(lila(nnl),ljla(nnl),lval(nnl)) + k = 0 + do i=1,nz + if (ila(i)<0) then + k=k+1 + lila(k) = ia(k) + ljla(k) = ja(k) + lval(k) = val(k) + end if + end do + if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl + call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& + & 1_psb_lpk_,desc_a%get_global_rows(),info) + end if case default write(0,*) name,' Ignoring wrong value for %remote_build' end select diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 293c5edd..14204ad9 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -117,7 +117,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, dupl, mold) case (psb_matbld_noremote_) ! nothing needed case (psb_matbld_remote_) - write(0,*) 'Need to implement data movement! ' + write(0,*) me,' Size of rmta:',a%rmta%get_nzeros() end select call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) diff --git a/base/tools/psb_dspins.F90 b/base/tools/psb_dspins.F90 index 1bd113dc..ac074487 100644 --- a/base/tools/psb_dspins.F90 +++ b/base/tools/psb_dspins.F90 @@ -156,21 +156,24 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) case (psb_matbld_noremote_) ! Do nothing case (psb_matbld_remote_) - nnl = count(ila(1:nz)<0) - allocate(lila(nnl),ljla(nnl),lval(nnl)) - k = 0 - do i=1,nz - if (ila(i)<0) then - k=k+1 - lila(k) = ia(k) - ljla(k) = ja(k) - lval(k) = val(k) - end if - end do - if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl - call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& - & 1_psb_lpk_,desc_a%get_global_rows(),info) + nnl = count(ila(1:nz)<0) + if (nnl > 0) then + write(0,*) 'Check on insert ',nnl + allocate(lila(nnl),ljla(nnl),lval(nnl)) + k = 0 + do i=1,nz + if (ila(i)<0) then + k=k+1 + lila(k) = ia(k) + ljla(k) = ja(k) + lval(k) = val(k) + end if + end do + if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl + call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& + & 1_psb_lpk_,desc_a%get_global_rows(),info) + end if case default write(0,*) name,' Ignoring wrong value for %remote_build' end select diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index e27724b2..4c019622 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -117,7 +117,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, dupl, mold) case (psb_matbld_noremote_) ! nothing needed case (psb_matbld_remote_) - write(0,*) 'Need to implement data movement! ' + write(0,*) me,' Size of rmta:',a%rmta%get_nzeros() end select call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) diff --git a/base/tools/psb_sspins.F90 b/base/tools/psb_sspins.F90 index 2ae3d8df..f8971ce2 100644 --- a/base/tools/psb_sspins.F90 +++ b/base/tools/psb_sspins.F90 @@ -157,20 +157,22 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ! Do nothing case (psb_matbld_remote_) nnl = count(ila(1:nz)<0) - allocate(lila(nnl),ljla(nnl),lval(nnl)) - k = 0 - do i=1,nz - if (ila(i)<0) then - k=k+1 - lila(k) = ia(k) - ljla(k) = ja(k) - lval(k) = val(k) - end if - end do - if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl - call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& - & 1_psb_lpk_,desc_a%get_global_rows(),info) - + if (nnl > 0) then + write(0,*) 'Check on insert ',nnl + allocate(lila(nnl),ljla(nnl),lval(nnl)) + k = 0 + do i=1,nz + if (ila(i)<0) then + k=k+1 + lila(k) = ia(k) + ljla(k) = ja(k) + lval(k) = val(k) + end if + end do + if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl + call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& + & 1_psb_lpk_,desc_a%get_global_rows(),info) + end if case default write(0,*) name,' Ignoring wrong value for %remote_build' end select diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 7021bbaa..6c9fc76f 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -117,7 +117,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, dupl, mold) case (psb_matbld_noremote_) ! nothing needed case (psb_matbld_remote_) - write(0,*) 'Need to implement data movement! ' + write(0,*) me,' Size of rmta:',a%rmta%get_nzeros() end select call a%cscnv(info,type=afmt,dupl=dupl, mold=mold) diff --git a/base/tools/psb_zspins.F90 b/base/tools/psb_zspins.F90 index d76450e3..bfe61a17 100644 --- a/base/tools/psb_zspins.F90 +++ b/base/tools/psb_zspins.F90 @@ -157,20 +157,22 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) ! Do nothing case (psb_matbld_remote_) nnl = count(ila(1:nz)<0) - allocate(lila(nnl),ljla(nnl),lval(nnl)) - k = 0 - do i=1,nz - if (ila(i)<0) then - k=k+1 - lila(k) = ia(k) - ljla(k) = ja(k) - lval(k) = val(k) - end if - end do - if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl - call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& - & 1_psb_lpk_,desc_a%get_global_rows(),info) - + if (nnl > 0) then + write(0,*) 'Check on insert ',nnl + allocate(lila(nnl),ljla(nnl),lval(nnl)) + k = 0 + do i=1,nz + if (ila(i)<0) then + k=k+1 + lila(k) = ia(k) + ljla(k) = ja(k) + lval(k) = val(k) + end if + end do + if (k /= nnl) write(0,*) name,' Wrong conversion?',k,nnl + call a%rmta%csput(nnl,lila,ljla,lval,1_psb_lpk_,desc_a%get_global_rows(),& + & 1_psb_lpk_,desc_a%get_global_rows(),info) + end if case default write(0,*) name,' Ignoring wrong value for %remote_build' end select diff --git a/test/pargen/psb_d_pde3d.F90 b/test/pargen/psb_d_pde3d.F90 index 2e3976ce..bbef8645 100644 --- a/test/pargen/psb_d_pde3d.F90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -208,7 +208,7 @@ contains type(psb_d_coo_sparse_mat) :: acoo type(psb_d_csr_sparse_mat) :: acsr real(psb_dpk_) :: zt(nb),x,y,z - integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ + integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_, mysz integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner ! For 3D partition @@ -377,6 +377,30 @@ contains ! call psb_cdall(ctxt,desc_a,info,vl=myidx) + ! + ! Add extra rows + ! + block + integer(psb_ipk_) :: ks + mysz = nlr + if (m>nlr) mysz = mysz + m/nlr + call psb_realloc(mysz,myidx,info) + ks = nlr + outer: do i=1,idim + do j=1,idim + do k=1,idim + if (outside(i,j,k,bndx,bndy,bndz,iamx,iamy,iamz)) then + ks = ks + 1 + if (ks > mysz) exit outer + call ijk2idx(myidx(ks),i,j,k,idim,idim,idim) + end if + end do + end do + end do outer + write(0,*) iam,' Check on extra nodes ',nlr,mysz,':',myidx(nlr+1:mysz) + + end block + ! ! Specify process topology ! @@ -463,8 +487,9 @@ contains call psb_barrier(ctxt) t1 = psb_wtime() - do ii=1, nlr,nb - ib = min(nb,nlr-ii+1) + do ii=1, mysz, nb + !ib = min(nb,nlr-ii+1) + ib = min(nb,mysz-ii+1) icoeff = 1 do k=1,ib i=ii+k-1 @@ -616,8 +641,15 @@ contains return end subroutine psb_d_gen_pde3d - - + function outside(i,j,k,bndx,bndy,bndz,iamx,iamy,iamz) result(res) + logical :: res + integer(psb_ipk_), intent(in) :: i,j,k,iamx,iamy,iamz + integer(psb_ipk_), intent(in) :: bndx(0:),bndy(0:),bndz(0:) + + res = (i=bndx(iamx+1)) & + & .or.(j=bndy(iamy+1)) & + & .or.(k=bndz(iamz+1)) + end function outside end module psb_d_pde3d_mod program psb_d_pde3d