Fix internals for SERIAL_MPI

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
 

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
 

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

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)