MPI allocation

wilfonba · Feb 19, 2025 · 87023bf · 87023bf
1 parent 4a0f95d
commit 87023bf
Showing 1 changed file with 9 additions and 10 deletions.
diff --git a/src/simulation/m_mpi_proxy.fpp b/src/simulation/m_mpi_proxy.fpp
@@ -72,6 +72,9 @@ module m_mpi_proxy
     !> @}
     !$acc declare create(v_size)
 
+    integer :: halo_size
+    !$acc declare create(halo_size)
+
     integer :: nVars !< nVars for surface tension communication
     !$acc declare create(nVars)
 
@@ -82,8 +85,6 @@ 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
@@ -107,10 +108,6 @@ contains
                 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
 
@@ -130,14 +127,16 @@ contains
                 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
 
         end if
 
+        !$acc update device(halo_size)
+
+        @:ALLOCATE(q_cons_buff_send(0:halo_size))
+
+        @:ALLOCATE(q_cons_buff_recv(0:ubound(q_cons_buff_send, 1)))
+
         if (surface_tension) then
             nVars = num_dims + 1
             if (n > 0) then