Fix internals for SERIAL_MPI

newG2L V3.7.0-1
Salvatore Filippone 4 years ago
parent 39e1efb508
commit ceda17be7e

@ -138,6 +138,9 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize)
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
goto 9999
end if
#if defined(SERIAL_MPI)
iprc(:) = 0
#else
call mpi_allgather(idx,nv,psb_mpi_lpk_,rmtidx,nv,psb_mpi_lpk_,icomm,minfo)
call idxmap%g2l(rmtidx(1:gsz),lclidx(1:gsz),info,owned=.true.)
!
@ -200,6 +203,7 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize)
write(0,*) me,' a2a_fnd: missing answers',count(iprc(1:hsz(me+1))<0),&
& gsz,hsz(me+1)
end if
#endif
end if
end if

@ -143,6 +143,9 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_realloc')
goto 9999
end if
#if defined(SERIAL_MPI)
iprc(:) = 0
#else
iprc = -1
xchg_alg = psi_get_adj_alg()
!if (me == 0) write(0,*) me,'adj_fnd_owner alg: ',xchg_alg,' Going through ',nidx,nadj
@ -430,7 +433,7 @@ subroutine psi_adjcncy_fnd_owner(idx,iprc,adj,idxmap,info)
call psb_errpush(info,name,a_err='invalid exchange alg choice')
goto 9999
end select
#endif
call psb_erractionrestore(err_act)
return

@ -150,6 +150,9 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
!
nv = size(idx)
call psb_realloc(nv,iprc,info)
#if defined(SERIAL_MPI)
iprc(:) = 0
#else
if (info == psb_success_) call psb_realloc(nv,tidx,info)
if (info == psb_success_) call psb_realloc(nv,tprc,info)
if (info == psb_success_) call psb_realloc(nv,tsmpl,info)
@ -279,6 +282,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
if (trace.and.(me == 0)) write(0,*) ' fnd_owner_loop remaining:',nqries_max
if (do_timings) call psb_toc(idx_loop_neigh)
end do fnd_owner_loop
#endif
call psb_erractionrestore(err_act)
return
@ -286,6 +290,7 @@ subroutine psi_graph_fnd_owner(idx,iprc,idxmap,info)
9999 call psb_error_handler(ctxt,err_act)
return
#if !defined(SERIAL_MPI)
contains
@ -404,5 +409,5 @@ contains
! if (me == 0) write(0,*)'adj_fnd_sweep: sweeps: ',isw
end subroutine psi_adj_fnd_sweep
#endif
end subroutine psi_graph_fnd_owner

@ -45,6 +45,7 @@ module mpi
integer(psb_mpk_), parameter :: mpi_character = 7
integer(psb_mpk_), parameter :: mpi_logical = 8
integer(psb_mpk_), parameter :: mpi_integer2 = 9
integer(psb_mpk_), parameter :: mpi_integer4 = 10
integer(psb_mpk_), parameter :: mpi_comm_null = -1
integer(psb_mpk_), parameter :: mpi_comm_world = 1
@ -823,7 +824,7 @@ contains
call psb_set_debug_unit(psb_err_unit)
#if defined(SERIAL_MPI)
ctxt = nctxt
ctxt%ctxt = nctxt ! allocate on assignment
nctxt = nctxt + 1
call psi_register_mpi_extras(info)

Loading…
Cancel
Save