Changeset 3888 for trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_transfert.F90

Timestamp:

Aug 12, 2025, 12:18:23 PM (3 days ago)

Author:

emillour

Message:

Common physics:
Update, following what is done for the Earth LMDZ6 GCM, of the
way some OpenMP transfers are done (less memory-hungry).
EM

File:

• trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 (modified) (13 diffs)

trunk/LMDZ.COMMON/libf/phy_common/mod_phys_lmdz_omp_transfert.F90

@@ -112 +112 @@
     
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Broadcast --> 4D   !!
+!! Definition of Broadcasts --> 4D   !!
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-!! -- Les chaine de charactère -- !!
+!! -- For strings -- !!
 
   SUBROUTINE bcast_omp_c(var)
@@ -125 +125 @@
   END SUBROUTINE bcast_omp_c
 
-!! -- Les entiers -- !!
+!! -- For integers -- !!
   
   SUBROUTINE bcast_omp_i(var)
@@ -200 +200 @@
 
 
-!! -- Les reels -- !!
+!! -- For reals -- !!
 
   SUBROUTINE bcast_omp_r(var)
@@ -275 +275 @@
 
   
-!! -- Les booleans -- !!
+!! -- For logicals -- !!
 
   SUBROUTINE bcast_omp_l(var)
@@ -351 +351 @@
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!! Definition des Scatter   --> 4D   !!
+!! Definition for Scatter   --> 4D   !!
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -557 +557 @@
 
     CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,1,buffer_r)
+    CALL gather_omp_rgen(VarIn,Varout,1)
     
   END SUBROUTINE gather_omp_r
@@ -569 +569 @@
 
     CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2),buffer_r)
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2))
         
   END SUBROUTINE gather_omp_r1
@@ -581 +581 @@
     
     CALL Check_buffer_r(size(VarOut))   
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3),buffer_r)
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3))
     
   END SUBROUTINE gather_omp_r2
@@ -593 +593 @@
 
     CALL Check_buffer_r(size(VarOut))       
-    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4),buffer_r)
+    CALL gather_omp_rgen(VarIn,Varout,Size(VarIn,2)*Size(VarIn,3)*Size(VarIn,4))
     
   END SUBROUTINE gather_omp_r3
@@ -774 +774 @@
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!    LES ROUTINES GENERIQUES    !
+!    GENERIC ROUTINES           !
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -999 +999 @@
 
 
-  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize,Buff)
+  SUBROUTINE gather_omp_rgen(VarIn,VarOut,dimsize)
   USE mod_phys_lmdz_omp_data
   USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
@@ -1006 +1006 @@
     INTEGER,INTENT(IN) :: dimsize
     REAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
-    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-    REAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
+    REAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize),TARGET :: VarOut
+
+    REAL, POINTER, SAVE :: Varout_ptr(:,:) ! Shared between threads NOT THREADPRIVATE
+
+    INTEGER :: i,ij
+    
+    !$OMP MASTER
+    Varout_ptr => VarOut
+    !$OMP END MASTER
+    !$OMP BARRIER
+
+    DO i=1,dimsize
+      DO ij=1,klon_omp
+        Varout_ptr(klon_omp_begin-1+ij,i)=VarIn(ij,i)
+      ENDDO
+    ENDDO  
+    !$OMP BARRIER
+
+  END SUBROUTINE gather_omp_rgen
+
+
+  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
+  USE mod_phys_lmdz_omp_data
+  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
+  IMPLICIT NONE
+
+    INTEGER,INTENT(IN) :: dimsize
+    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
+    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
+    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
 
     INTEGER :: i,ij
@@ -1028 +1056 @@
   !$OMP BARRIER
 
-  END SUBROUTINE gather_omp_rgen
-
-
-  SUBROUTINE gather_omp_lgen(VarIn,VarOut,dimsize,Buff)
-  USE mod_phys_lmdz_omp_data
-  USE mod_phys_lmdz_mpi_data, ONLY : klon_mpi 
-  IMPLICIT NONE
-
-    INTEGER,INTENT(IN) :: dimsize
-    LOGICAL,INTENT(IN),DIMENSION(klon_omp,dimsize) :: VarIn
-    LOGICAL,INTENT(OUT),DIMENSION(klon_mpi,dimsize) :: VarOut
-    LOGICAL,INTENT(INOUT),DIMENSION(klon_mpi,dimsize) :: Buff
-
-    INTEGER :: i,ij
-    
-    DO i=1,dimsize
-      DO ij=1,klon_omp
-        Buff(klon_omp_begin-1+ij,i)=VarIn(ij,i)
-      ENDDO
-    ENDDO
-  !$OMP BARRIER  
-
-
-  !$OMP MASTER
-    DO i=1,dimsize
-      DO ij=1,klon_mpi
-        VarOut(ij,i)=Buff(ij,i)
-      ENDDO
-    ENDDO  
-  !$OMP END MASTER
-  !$OMP BARRIER
-
   END SUBROUTINE gather_omp_lgen