From 39e1efb5088f2c50053c9b3f47c93629adad3984 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 13 Apr 2021 16:54:37 +0200 Subject: [PATCH 1/2] Fix test programs for SERIAL_MPI --- test/pargen/{psb_d_pde2d.f90 => psb_d_pde2d.F90} | 4 ++++ test/pargen/{psb_d_pde3d.f90 => psb_d_pde3d.F90} | 4 ++++ test/pargen/{psb_s_pde2d.f90 => psb_s_pde2d.F90} | 4 ++++ test/pargen/{psb_s_pde3d.f90 => psb_s_pde3d.F90} | 4 ++++ 4 files changed, 16 insertions(+) rename test/pargen/{psb_d_pde2d.f90 => psb_d_pde2d.F90} (99%) rename test/pargen/{psb_d_pde3d.f90 => psb_d_pde3d.F90} (99%) rename test/pargen/{psb_s_pde2d.f90 => psb_s_pde2d.F90} (99%) rename test/pargen/{psb_s_pde3d.f90 => psb_s_pde3d.F90} (99%) diff --git a/test/pargen/psb_d_pde2d.f90 b/test/pargen/psb_d_pde2d.F90 similarity index 99% rename from test/pargen/psb_d_pde2d.f90 rename to test/pargen/psb_d_pde2d.F90 index 620acd16..a5668c7d 100644 --- a/test/pargen/psb_d_pde2d.f90 +++ b/test/pargen/psb_d_pde2d.F90 @@ -314,7 +314,11 @@ contains ! A nifty MPI function will split the process list npdims = 0 +#if defined(SERIAL_MPI) + npdims = 1 +#else call mpi_dims_create(np,2,npdims,info) +#endif npx = npdims(1) npy = npdims(2) diff --git a/test/pargen/psb_d_pde3d.f90 b/test/pargen/psb_d_pde3d.F90 similarity index 99% rename from test/pargen/psb_d_pde3d.f90 rename to test/pargen/psb_d_pde3d.F90 index fd0d0530..c56f2427 100644 --- a/test/pargen/psb_d_pde3d.f90 +++ b/test/pargen/psb_d_pde3d.F90 @@ -330,7 +330,11 @@ contains ! A nifty MPI function will split the process list npdims = 0 +#if defined(SERIAL_MPI) + npdims = 1 +#else call mpi_dims_create(np,3,npdims,info) +#endif npx = npdims(1) npy = npdims(2) npz = npdims(3) diff --git a/test/pargen/psb_s_pde2d.f90 b/test/pargen/psb_s_pde2d.F90 similarity index 99% rename from test/pargen/psb_s_pde2d.f90 rename to test/pargen/psb_s_pde2d.F90 index 9b9ef3a4..ee2f103c 100644 --- a/test/pargen/psb_s_pde2d.f90 +++ b/test/pargen/psb_s_pde2d.F90 @@ -314,7 +314,11 @@ contains ! A nifty MPI function will split the process list npdims = 0 +#if defined(SERIAL_MPI) + npdims = 1 +#else call mpi_dims_create(np,2,npdims,info) +#endif npx = npdims(1) npy = npdims(2) diff --git a/test/pargen/psb_s_pde3d.f90 b/test/pargen/psb_s_pde3d.F90 similarity index 99% rename from test/pargen/psb_s_pde3d.f90 rename to test/pargen/psb_s_pde3d.F90 index 631633d9..975837fe 100644 --- a/test/pargen/psb_s_pde3d.f90 +++ b/test/pargen/psb_s_pde3d.F90 @@ -330,7 +330,11 @@ contains ! A nifty MPI function will split the process list npdims = 0 +#if defined(SERIAL_MPI) + npdims = 1 +#else call mpi_dims_create(np,3,npdims,info) +#endif npx = npdims(1) npy = npdims(2) npz = npdims(3) From ceda17be7eedbde9f605286ff8388538e52ac203 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 13 Apr 2021 16:54:47 +0200 Subject: [PATCH 2/2] Fix internals for SERIAL_MPI --- base/internals/psi_a2a_fnd_owner.F90 | 6 +++++- base/internals/psi_adjcncy_fnd_owner.F90 | 5 ++++- base/internals/psi_graph_fnd_owner.F90 | 9 +++++++-- base/modules/penv/psi_penv_mod.F90 | 3 ++- 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/base/internals/psi_a2a_fnd_owner.F90 b/base/internals/psi_a2a_fnd_owner.F90 index 3442e765..edc160d0 100644 --- a/base/internals/psi_a2a_fnd_owner.F90 +++ b/base/internals/psi_a2a_fnd_owner.F90 @@ -133,11 +133,14 @@ subroutine psi_a2a_fnd_owner(idx,iprc,idxmap,info,samesize) ! Probably yes. ! gsz = nv*np - Allocate(rmtidx(gsz),lclidx(gsz),iprc(nv),stat=info) + Allocate(rmtidx(gsz),lclidx(gsz),iprc(nv),stat=info) if (info /= psb_success_) then 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 diff --git a/base/internals/psi_adjcncy_fnd_owner.F90 b/base/internals/psi_adjcncy_fnd_owner.F90 index ab840575..03aa0f09 100644 --- a/base/internals/psi_adjcncy_fnd_owner.F90 +++ b/base/internals/psi_adjcncy_fnd_owner.F90 @@ -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 diff --git a/base/internals/psi_graph_fnd_owner.F90 b/base/internals/psi_graph_fnd_owner.F90 index 356026c6..966af403 100644 --- a/base/internals/psi_graph_fnd_owner.F90 +++ b/base/internals/psi_graph_fnd_owner.F90 @@ -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,13 +282,15 @@ 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 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 diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index f12609c1..0563a4b1 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -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)