MPI allocation fix

wilfonba · Feb 19, 2025 · 4a0f95d · 4a0f95d
1 parent 0898f43
commit 4a0f95d
Showing 1 changed file with 18 additions and 10 deletions.
diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp
@@ -82,6 +82,8 @@ contains
         !!      other procedures that are necessary to setup the module.
     subroutine s_initialize_mpi_proxy_module
 
+    real(kind(0d0)) :: halo_size
+
 #ifdef MFC_MPI
 
         ! Allocating q_cons_buff_send/recv and ib_buff_send/recv. Please note that
@@ -91,39 +93,45 @@ contains
         if (qbmm .and. .not. polytropic) then
             if (n > 0) then
                 if (p > 0) then
-                    @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*(sys_size + 2*nb*4)* &
+
+                    halo_size = -1 + buff_size*(sys_size + 2*nb*4)* &
                                              & (m + 2*buff_size + 1)* &
                                              & (n + 2*buff_size + 1)* &
                                              & (p + 2*buff_size + 1)/ &
-                                             & (min(m, n, p) + 2*buff_size + 1)))
+                                             & (min(m, n, p) + 2*buff_size + 1)
                 else
-                    @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*(sys_size + 2*nb*4)* &
-                                             & (max(m, n) + 2*buff_size + 1)))
+                    halo_size = -1 + buff_size*(sys_size + 2*nb*4)* &
+                                             & (max(m, n) + 2*buff_size + 1)
                 end if
             else
-                @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*(sys_size + 2*nb*4)))
+                halo_size = -1 + buff_size*(sys_size + 2*nb*4)
             end if
 
+            @:ALLOCATE(q_cons_buff_send(0:halo_size))
+
             @:ALLOCATE(q_cons_buff_recv(0:ubound(q_cons_buff_send, 1)))
 
             v_size = sys_size + 2*nb*4
         else
 
             if (n > 0) then
                 if (p > 0) then
-                    @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*sys_size* &
+
+                    halo_size = -1 + buff_size*sys_size* &
                                              & (m + 2*buff_size + 1)* &
                                              & (n + 2*buff_size + 1)* &
                                              & (p + 2*buff_size + 1)/ &
-                                             & (min(m, n, p) + 2*buff_size + 1)))
+                                             & (min(m, n, p) + 2*buff_size + 1)
                 else
-                    @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*sys_size* &
-                                             & (max(m, n) + 2*buff_size + 1)))
+                    halo_size = -1 + buff_size*sys_size* &
+                                             & (max(m, n) + 2*buff_size + 1)
                 end if
             else
-                @:ALLOCATE(q_cons_buff_send(0:-1 + buff_size*sys_size))
+                halo_size = -1 + buff_size*sys_size
             end if
 
+            @:ALLOCATE(q_cons_buff_send(0:halo_size))
+
             @:ALLOCATE(q_cons_buff_recv(0:ubound(q_cons_buff_send, 1)))
 
             v_size = sys_size