Changeset 985 for LMDZ4/trunk/libf/dyn3dpar/parallel.F90

Timestamp:

Jul 30, 2008, 5:50:03 PM (16 years ago)

Author:

Laurent Fairhead

Message:

Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM
LF

File:

• LMDZ4/trunk/libf/dyn3dpar/parallel.F90 (modified) (15 diffs)

LMDZ4/trunk/libf/dyn3dpar/parallel.F90

@@ -16 +16 @@
     integer, allocatable, save, dimension(:) :: jj_nb_para
     integer, save :: OMP_CHUNK
-    
+    integer, save :: omp_rank
+    integer, save :: omp_size  
+!$OMP THREADPRIVATE(omp_rank)
+
  contains
  
@@ -27 +30 @@
       integer :: type_size
       integer, dimension(3) :: blocklen,type
-      
-      
+      integer :: comp_id
+#ifdef _OPENMP    
+      INTEGER :: OMP_GET_NUM_THREADS
+      EXTERNAL OMP_GET_NUM_THREADS
+      INTEGER :: OMP_GET_THREAD_NUM
+      EXTERNAL OMP_GET_THREAD_NUM
+#endif  
       include 'mpif.h'
 #include "dimensions.h"
@@ -95 +103 @@
       print *,"ij_begin",ij_begin
       print *,"ij_end",ij_end
-    
+
+!$OMP PARALLEL
+
+#ifdef _OPENMP
+!$OMP MASTER
+        omp_size=OMP_GET_NUM_THREADS()
+!$OMP END MASTER
+        omp_rank=OMP_GET_THREAD_NUM()    
+#else    
+        omp_size=1
+        omp_rank=0
+#endif
+!$OMP END PARALLEL         
     
     end subroutine init_parallel
@@ -230 +250 @@
       REAL, dimension(:),allocatable :: Buffer_Recv_up,Buffer_Recv_down
       INTEGER :: Buffer_size      
-      
+
+!$OMP CRITICAL (MPI)      
       call MPI_Barrier(COMM_LMDZ,ierr)
+!$OMP END CRITICAL (MPI)
       call VTb(VThallo)
       
@@ -266 +288 @@
         allocate(Buffer_Send_up(Buffer_size))
         call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up)
+!$OMP CRITICAL (MPI)
         call MPI_ISSEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1,     &
                         COMM_LMDZ,Request(NbRequest),ierr)
+!$OMP END CRITICAL (MPI)
       ENDIF
   
@@ -277 +301 @@
         call PACK_Data(Field(ij_end+1-up*iip1,1),ij,ll,up,Buffer_send_down)
         
+!$OMP CRITICAL (MPI)
         call MPI_ISSEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1,     &
                         COMM_LMDZ,Request(NbRequest),ierr)
+!$OMP END CRITICAL (MPI)
       ENDIF
     
@@ -287 +313 @@
         allocate(Buffer_recv_up(Buffer_size))
               
+!$OMP CRITICAL (MPI)
         call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1,  &
                         COMM_LMDZ,Request(NbRequest),ierr)
+!$OMP END CRITICAL (MPI)
      
        
@@ -298 +326 @@
         allocate(Buffer_recv_down(Buffer_size))
         
+!$OMP CRITICAL (MPI)
         call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1,     &
                         COMM_LMDZ,Request(NbRequest),ierr)
+!$OMP END CRITICAL (MPI)
       
         
@@ -309 +339 @@
 
       call VTe(VThallo)
+!$OMP CRITICAL (MPI)
       call MPI_Barrier(COMM_LMDZ,ierr)
+!$OMP END CRITICAL (MPI)
+
       RETURN
       
     end subroutine exchange_Hallo
     
-    
+
     subroutine Gather_Field(Field,ij,ll,rank)
     implicit none
@@ -342 +375 @@
       if (MPI_Rank==rank) then
         allocate(Buffer_Recv(ij*ll))
+
+!CDIR NOVECTOR
         do i=0,MPI_Size-1
-          
+           
           if (ij==ip1jmp1) then 
             Recv_count(i)=(jj_end_para(i)-jj_begin_para(i)+1)*ll*iip1
@@ -351 +386 @@
             stop 'erreur dans Gather_Field'
           endif
-          
+                 
           if (i==0) then 
             displ(i)=0 
@@ -361 +396 @@
         
       endif
-      
+  
+!$OMP CRITICAL (MPI)
       call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8,   &
                         Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr)
+!$OMP END CRITICAL (MPI)
       
       if (MPI_Rank==rank) then                  
@@ -380 +417 @@
       
       endif
-      
+     
     end subroutine Gather_Field
-    
+
+
     subroutine AllGather_Field(Field,ij,ll)
     implicit none
@@ -394 +432 @@
       
       call Gather_Field(Field,ij,ll,0)
+!$OMP CRITICAL (MPI)
       call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr)
+!$OMP END CRITICAL (MPI)
       
     end subroutine AllGather_Field
@@ -409 +449 @@
       INTEGER :: ierr
       
+!$OMP CRITICAL (MPI)
       call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr)
+!$OMP END CRITICAL (MPI)
       
     end subroutine Broadcast_Field