From c13a51ca9a441e744f71bcf99146af98723a3a9c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 19 Apr 2018 09:27:58 +0100 Subject: [PATCH] Fix scatter for IPK=8. Fix pargen test programs. --- base/comm/psb_cscatter_a.F90 | 40 +++++++++++++++++++++--------------- base/comm/psb_dscatter_a.F90 | 40 +++++++++++++++++++++--------------- base/comm/psb_escatter_a.F90 | 40 +++++++++++++++++++++--------------- base/comm/psb_mscatter_a.F90 | 40 +++++++++++++++++++++--------------- base/comm/psb_sscatter_a.F90 | 40 +++++++++++++++++++++--------------- base/comm/psb_zscatter_a.F90 | 40 +++++++++++++++++++++--------------- test/pargen/psb_d_pde2d.f90 | 7 +++++-- test/pargen/psb_d_pde3d.f90 | 5 ++++- test/pargen/psb_s_pde2d.f90 | 7 +++++-- test/pargen/psb_s_pde3d.f90 | 5 ++++- 10 files changed, 162 insertions(+), 102 deletions(-) diff --git a/base/comm/psb_cscatter_a.F90 b/base/comm/psb_cscatter_a.F90 index fea0a1ed..1eef00af 100644 --- a/base/comm/psb_cscatter_a.F90 +++ b/base/comm/psb_cscatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx complex(psb_spk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx complex(psb_spk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/base/comm/psb_dscatter_a.F90 b/base/comm/psb_dscatter_a.F90 index 1b8b1732..32fd43a3 100644 --- a/base/comm/psb_dscatter_a.F90 +++ b/base/comm/psb_dscatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx real(psb_dpk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx real(psb_dpk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/base/comm/psb_escatter_a.F90 b/base/comm/psb_escatter_a.F90 index c0bb1248..028b9e46 100644 --- a/base/comm/psb_escatter_a.F90 +++ b/base/comm/psb_escatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx integer(psb_epk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx integer(psb_epk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/base/comm/psb_mscatter_a.F90 b/base/comm/psb_mscatter_a.F90 index 71c02a99..826ece53 100644 --- a/base/comm/psb_mscatter_a.F90 +++ b/base/comm/psb_mscatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx integer(psb_mpk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx integer(psb_mpk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/base/comm/psb_sscatter_a.F90 b/base/comm/psb_sscatter_a.F90 index 11e79d93..2a07d297 100644 --- a/base/comm/psb_sscatter_a.F90 +++ b/base/comm/psb_sscatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx real(psb_spk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx real(psb_spk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/base/comm/psb_zscatter_a.F90 b/base/comm/psb_zscatter_a.F90 index d01fac0c..aa501562 100644 --- a/base/comm/psb_zscatter_a.F90 +++ b/base/comm/psb_zscatter_a.F90 @@ -62,13 +62,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & col,pos - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx complex(psb_dpk_),allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), allocatable :: displ(:), all_dim(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:) character(len=20) :: name, ch_err @@ -158,9 +158,13 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if (iam == iroot) then displ(1)=0 @@ -186,7 +190,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) @@ -300,12 +304,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, idx, nrow,& + integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr + integer(psb_ipk_) :: ierr(5), err_act, nrow,& & ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx - integer(psb_lpk_) :: m, n, i, j, iglobx, jglobx + integer(psb_lpk_) :: m, n, i, j, idx, iglobx, jglobx complex(psb_dpk_), allocatable :: scatterv(:) - integer(psb_ipk_), allocatable :: displ(:), all_dim(:) + integer(psb_mpk_), 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 @@ -387,9 +391,13 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) end do else call psb_get_rank(rootrank,ictxt,iroot) - - call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& - & 1,psb_mpi_ipk_,rootrank,icomm,info) + ! + ! This is potentially unsafe when IPK=8 + ! But then, IPK=8 is highly experimental anyway. + ! + nlr = nrow + call mpi_gather(nlr,1,psb_mpi_mpk_,all_dim,& + & 1,psb_mpi_mpk_,rootrank,icomm,info) if(iam == iroot) then displ(1)=0 @@ -420,7 +428,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root) goto 9999 end if - call mpi_gatherv(ltg,nrow,& + call mpi_gatherv(ltg,nlr,& & psb_mpi_lpk_,l_t_g_all,all_dim,& & displ,psb_mpi_lpk_,rootrank,icomm,info) diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.f90 index 8d2574a1..56c70b0e 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.f90 @@ -184,8 +184,11 @@ contains integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 2D partition - integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny + ! For 3D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(2), npp, minfo + integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny integer(psb_ipk_), allocatable :: bndx(:),bndy(:) ! Process grid integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.f90 index c01180ab..f1779372 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.f90 @@ -201,7 +201,10 @@ contains integer(psb_lpk_) :: m,n,glob_row integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner ! For 3D partition - integer(psb_ipk_) :: npx,npy,npz, npdims(3),iamx,iamy,iamz,mynx,myny,mynz + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(3), npp, minfo + integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) ! Process grid integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.f90 index 5700d821..c824e599 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.f90 @@ -184,8 +184,11 @@ contains integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_ integer(psb_lpk_) :: m,n,glob_row integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner - ! For 2D partition - integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny + ! For 3D partition + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(2), npp, minfo + integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny integer(psb_ipk_), allocatable :: bndx(:),bndy(:) ! Process grid integer(psb_ipk_) :: np, iam diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.f90 index 882ca244..30786bf2 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.f90 @@ -201,7 +201,10 @@ contains integer(psb_lpk_) :: m,n,glob_row integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner ! For 3D partition - integer(psb_ipk_) :: npx,npy,npz, npdims(3),iamx,iamy,iamz,mynx,myny,mynz + ! Note: integer control variables going directly into an MPI call + ! must be 4 bytes, i.e. psb_mpk_ + integer(psb_mpk_) :: npdims(3), npp, minfo + integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:) ! Process grid integer(psb_ipk_) :: np, iam