Changeset 4103 for LMDZ6/trunk/libf/phy_common

Timestamp:

Mar 17, 2022, 11:51:36 AM (3 years ago)

Author:

Laurent Fairhead

Message:

Inclusion of some corrections and optimisations for XIOS done by
Arnaud Durocher during his TGCC mission.
Included here are r3703, r3704, r3750, r3751, r3752 from his
LMDZ6/branches/Optimisation_LMDZ branch

File:

• LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.F90 (modified) (7 diffs)

LMDZ6/trunk/libf/phy_common/mod_phys_lmdz_omp_transfert.F90

@@ -498 +498 @@
     REAL,INTENT(OUT),DIMENSION(:) :: VarOut
 
-    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
@@ -509 +508 @@
     REAL,INTENT(IN),DIMENSION(:,:) :: VarIn
     REAL,INTENT(OUT),DIMENSION(:,:) :: VarOut
-
-    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
@@ -521 +519 @@
     REAL,INTENT(IN),DIMENSION(:,:,:) :: VarIn
     REAL,INTENT(OUT),DIMENSION(:,:,:) :: VarOut
-    
-    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
@@ -533 +530 @@
     REAL,INTENT(IN),DIMENSION(:,:,:,:) :: VarIn
     REAL,INTENT(OUT),DIMENSION(:,:,:,:) :: VarOut
-
-    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
@@ -1071 +1067 @@
 
 
-  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 
@@ -1078 +1074 @@
     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
@@ -1100 +1123 @@
   !$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