Changeset 985 for LMDZ4/trunk/libf/dyn3dpar/mod_hallo.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/mod_hallo.F90 (modified) (22 diffs)

LMDZ4/trunk/libf/dyn3dpar/mod_hallo.F90

@@ -2 +2 @@
 USE parallel
 implicit none
-
+  logical,save :: use_mpi_alloc
   integer, parameter :: MaxRequest=200
   integer, parameter :: MaxProc=80
@@ -9 +9 @@
   
   integer,save       :: MaxBufferSize_Used
- 
-    real,save,pointer,dimension(:) :: Buffer
-
-   integer,dimension(Listsize) :: Buffer_Pos
-   integer :: Index_Pos
+!$OMP THREADPRIVATE( MaxBufferSize_Used)
+
+   real,save,pointer,dimension(:) :: Buffer
+!$OMP THREADPRIVATE(Buffer)
+
+   integer,save,dimension(Listsize) :: Buffer_Pos
+   integer,save :: Index_Pos
+!$OMP THREADPRIVATE(Buffer_Pos,Index_pos)
    
   type Hallo
@@ -47 +50 @@
     MaxBufferSize_Used=0
 
-    CALL create_global_mpi_buffer
-    
+    IF (use_mpi_alloc) THEN
+      CALL create_global_mpi_buffer
+    ELSE 
+      CALL create_standard_mpi_buffer
+    ENDIF
+     
   end subroutine init_mod_hallo
-
 
   SUBROUTINE create_standard_mpi_buffer
@@ -59 +65 @@
   END SUBROUTINE create_standard_mpi_buffer
   
-
   SUBROUTINE create_global_mpi_buffer
   IMPLICIT NONE
@@ -68 +73 @@
     INTEGER :: i,ierr
 
-
+!  Allocation du buffer MPI
       Bs=8*MaxBufferSize
+!$OMP CRITICAL (MPI)
       CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+!$OMP END CRITICAL (MPI)
       DO i=1,MaxBufferSize
         MPI_Buffer(i)=i
@@ -88 +95 @@
                                       
   END SUBROUTINE create_global_mpi_buffer
-
-
+ 
       
   subroutine allocate_buffer(Size,Index,Pos)
@@ -381 +387 @@
       integer :: i,rank,l,ij,Pos,ierr
       integer :: offset
-!      real,dimension(:),pointer :: Buffer
       real,dimension(:,:),pointer :: Field
       integer :: Nb
@@ -392 +397 @@
         do i=1,Req%NbRequest
           PtrHallo=>Req%Hallo(i)
-          SizeBuffer=SizeBuffer+PtrHallo%size*PtrHallo%NbLevel*iip1
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+          DO l=1,PtrHallo%NbLevel
+            SizeBuffer=SizeBuffer+PtrHallo%size*iip1
+          ENDDO
+!$OMP ENDDO NOWAIT          
         enddo
       
         if (SizeBuffer>0) then
        
-!          allocate(Req%Buffer(SizeBuffer))
           call allocate_buffer(SizeBuffer,Req%Index,Req%pos)
 
           Pos=Req%Pos
-!          Buffer=>req%Buffer
           do i=1,Req%NbRequest
             PtrHallo=>Req%Hallo(i)
@@ -407 +414 @@
             Nb=iip1*PtrHallo%size-1
             Field=>PtrHallo%Field
-            
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
             do l=1,PtrHallo%NbLevel
 !cdir NODEP
@@ -413 +421 @@
                 Buffer(Pos+ij)=Field(Offset+ij,l)
               enddo
-!              Buffer(Pos:Pos+Nb)=Field(offset:offset+Nb,l)
               
               Pos=Pos+Nb+1
             enddo
-            
+!$OMP END DO NOWAIT            
           enddo
     
-!         print *, 'process',MPI_RANK,'ISSEND: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer
-!         call MPI_ISSEND(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
-!                         COMM_LMDZ,Req%MSG_Request,ierr)
-         call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
+!$OMP CRITICAL (MPI)
+         call MPI_ISSEND(Buffer(req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag+1000*omp_rank,     &
                          COMM_LMDZ,Req%MSG_Request,ierr)
-
+!         PRINT *,"-------------------------------------------------------------------"
+!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
+!         PRINT *,"Requete envoye au proc :",rank,"tag :",a_request%tag+1000*omp_rank
+!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
+!         PRINT *,"-------------------------------------------------------------------"
+!$OMP END CRITICAL (MPI)
         endif
 
@@ -438 +448 @@
           do i=1,Req%NbRequest
             PtrHallo=>Req%Hallo(i)
-            SizeBuffer=SizeBuffer+PtrHallo%size*PtrHallo%NbLevel*iip1
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
+            DO l=1,PtrHallo%NbLevel
+              SizeBuffer=SizeBuffer+PtrHallo%size*iip1
+            ENDDO
+!$OMP ENDDO NOWAIT          
           enddo
         
           if (SizeBuffer>0) then
-!            allocate(Req%Buffer(SizeBuffer))
+
              call allocate_buffer(SizeBuffer,Req%Index,Req%Pos)
-!            print *, 'process',MPI_RANK,'IRECV: requette ',a_request%tag,'au process',rank,'de taille',SizeBuffer
-            
-!           call MPI_IRECV(Req%Buffer,SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
-!                           COMM_LMDZ,Req%MSG_Request,ierr)
-            call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag,     &
+!$OMP CRITICAL (MPI)
+             call MPI_IRECV(Buffer(Req%Pos),SizeBuffer,MPI_REAL8,rank,a_request%tag+1000*omp_rank,     &
                            COMM_LMDZ,Req%MSG_Request,ierr)
-
+!         PRINT *,"-------------------------------------------------------------------"
+!         PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->"
+!         PRINT *,"Requete en attente du proc :",rank,"tag :",a_request%tag+1000*omp_rank
+!         PRINT *,"Taille du message :",SizeBuffer,"requete no :",Req%MSG_Request
+!         PRINT *,"-------------------------------------------------------------------"
+
+!$OMP END CRITICAL (MPI)
           endif
       
@@ -492 +510 @@
       enddo
      
-      if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
-      
+      if (NbRequest>0) then
+!$OMP CRITICAL (MPI)
+!        PRINT *,"-------------------------------------------------------------------"
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
+!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
+        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
+!        PRINT *,"-------------------------------------------------------------------"
+!$OMP END CRITICAL (MPI)
+      endif
       do rank=0,MPI_Size-1
         Req=>a_request%RequestRecv(rank)
@@ -502 +528 @@
             offset=(PtrHallo%offset-1)*iip1+1
             Nb=iip1*PtrHallo%size-1
-            
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
             do l=1,PtrHallo%NbLevel
 !cdir NODEP
@@ -508 +535 @@
                 PtrHallo%Field(offset+ij,l)=Buffer(Pos+ij)
               enddo
-!              PtrHallo%Field(offset:offset+Nb,l)=Buffer(Pos:Pos+Nb)
-!             do ij=offset,offset+iip1*PtrHallo%size-1
-!                PtrHallo%Field(ij,l)=Buffer(Pos)
-!                Pos=Pos+1
-!              enddo
+
               Pos=Pos+Nb+1
             enddo
-            
+!$OMP ENDDO NOWAIT          
           enddo
         endif
@@ -566 +589 @@
       
 
-      if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
-      
+      if (NbRequest>0) THEN 
+!$OMP CRITICAL (MPI)     
+!        PRINT *,"-------------------------------------------------------------------"
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
+!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
+        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
+!        PRINT *,"-------------------------------------------------------------------"
+
+!$OMP END CRITICAL (MPI)
+      endif      
       
       do rank=0,MPI_SIZE-1
@@ -608 +640 @@
      
       
-      if (NbRequest>0) call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
+      if (NbRequest>0) then
+!$OMP CRITICAL (MPI)     
+!        PRINT *,"-------------------------------------------------------------------"
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"en attente"
+!        PRINT *,"No des requetes :",TabRequest(1:NbRequest)
+        call MPI_WAITALL(NbRequest,TabRequest,TabStatus,ierr)
+!        PRINT *,"Process de rang",mpi_rank,"Task : ",omp_rank,"--->",NbRequest,"complete"
+!        PRINT *,"-------------------------------------------------------------------"
+!$OMP END CRITICAL (MPI)     
+      endif
       
       do rank=0,MPI_Size-1
@@ -618 +659 @@
             offset=(PtrHallo%offset-1)*iip1+1
             Nb=iip1*PtrHallo%size-1
-            
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)            
             do l=1,PtrHallo%NbLevel
 !cdir NODEP
@@ -626 +667 @@
                  Pos=Pos+Nb+1
             enddo
+!$OMP END DO NOWAIT
           enddo
         endif
@@ -651 +693 @@
     include 'mpif.h'
     
-    INTEGER :: ij,ll
+    INTEGER :: ij,ll,l
     REAL, dimension(ij,ll) :: FieldS
     REAL, dimension(ij,ll) :: FieldR
@@ -673 +715 @@
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
-      FieldR(ijb:ije,1:ll)=FieldS(ijb:ije,1:ll)
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l=1,ll
+        FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
+      enddo
+!$OMP ENDDO NOWAIT
     endif
+
 
   end subroutine CopyField    
@@ -691 +739 @@
     integer,dimension(0:MPI_Size-1) :: jj_Begin_New,jj_End_New
 
-    integer ::i,jje,jjb,ijb,ije
+    integer ::i,jje,jjb,ijb,ije,l
 
      
@@ -710 +758 @@
       ijb=(jjb-1)*iip1+1
       ije=jje*iip1
-      FieldR(ijb:ije,1:ll)=FieldS(ijb:ije,1:ll)
+
+!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
+      do l=1,ll
+        FieldR(ijb:ije,l)=FieldS(ijb:ije,l)
+      enddo
+!$OMP ENDDO NOWAIT
+
     endif
    end subroutine CopyFieldHallo