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

Fix scatter for IPK=8. Fix pargen test programs.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 90603ba890
commit c13a51ca9a
10 changed files with 162 additions and 102 deletions
Show Stats Download Patch File Download Diff File

40
base/comm/psb_cscatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

40
base/comm/psb_dscatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

40
base/comm/psb_escatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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_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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_escatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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_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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_escatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

40
base/comm/psb_mscatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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_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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_mscatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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_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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_mscatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

40
base/comm/psb_sscatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

40
base/comm/psb_zscatter_a.F90
Unescape Escape View File

@ -62,13 +62,13 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam integer(psb_mpk_) :: ictxt, np, me, iroot, icomm, myrank, rootrank, iam, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, & & ilocx, jlocx, lda_locx, lda_globx, lock, globk, k, maxk, &
& col,pos & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -158,9 +158,13 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if (iam == iroot) then
displ(1)=0 displ(1)=0
@ -186,7 +190,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)
@ -300,12 +304,12 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
! locals ! locals
integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank integer(psb_mpk_) :: ictxt, np, iam, iroot, iiroot, icomm, myrank, rootrank, nlr
integer(psb_ipk_) :: ierr(5), err_act, idx, nrow,& integer(psb_ipk_) :: ierr(5), err_act, nrow,&
& ilocx, jlocx, lda_locx, lda_globx, k, pos, ilx, jlx & 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(:) 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(:) integer(psb_lpk_), allocatable :: l_t_g_all(:), ltg(:)
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
@ -387,9 +391,13 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
end do end do
else else
call psb_get_rank(rootrank,ictxt,iroot) call psb_get_rank(rootrank,ictxt,iroot)
!
call mpi_gather(nrow,1,psb_mpi_ipk_,all_dim,& ! This is potentially unsafe when IPK=8
& 1,psb_mpi_ipk_,rootrank,icomm,info) ! 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 if(iam == iroot) then
displ(1)=0 displ(1)=0
@ -420,7 +428,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
goto 9999 goto 9999
end if end if
call mpi_gatherv(ltg,nrow,& call mpi_gatherv(ltg,nlr,&
& psb_mpi_lpk_,l_t_g_all,all_dim,& & psb_mpi_lpk_,l_t_g_all,all_dim,&
& displ,psb_mpi_lpk_,rootrank,icomm,info) & displ,psb_mpi_lpk_,rootrank,icomm,info)

7
test/pargen/psb_d_pde2d.f90
Unescape Escape View File

@ -184,8 +184,11 @@ contains
integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row integer(psb_lpk_) :: m,n,glob_row
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
! For 2D partition ! For 3D partition
integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny ! 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(:) integer(psb_ipk_), allocatable :: bndx(:),bndy(:)
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam

5
test/pargen/psb_d_pde3d.f90
Unescape Escape View File

@ -201,7 +201,10 @@ contains
integer(psb_lpk_) :: m,n,glob_row integer(psb_lpk_) :: m,n,glob_row
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
! For 3D partition ! 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(:) integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:)
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam

7
test/pargen/psb_s_pde2d.f90
Unescape Escape View File

@ -184,8 +184,11 @@ contains
integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nt,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row integer(psb_lpk_) :: m,n,glob_row
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
! For 2D partition ! For 3D partition
integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny ! 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(:) integer(psb_ipk_), allocatable :: bndx(:),bndy(:)
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam

5
test/pargen/psb_s_pde3d.f90
Unescape Escape View File

@ -201,7 +201,10 @@ contains
integer(psb_lpk_) :: m,n,glob_row integer(psb_lpk_) :: m,n,glob_row
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
! For 3D partition ! 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(:) integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:)
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam

Write Preview
Loading…
Cancel
Save