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

Timestamp:

Jun 4, 2007, 4:13:10 PM (18 years ago)

Author:

Laurent Fairhead

Message:

Merge entre la version V3_conv et le HEAD
YM, JG, LF

File:

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

LMDZ4/trunk/libf/dyn3dpar/parallel.F90

@@ -3 +3 @@
     integer, save :: mpi_size
     integer, save :: mpi_rank
+    integer, save :: COMM_LMDZ
     integer, save :: jj_begin
     integer, save :: jj_end
@@ -14 +15 @@
     integer, allocatable, save, dimension(:) :: jj_end_para
     integer, allocatable, save, dimension(:) :: jj_nb_para
+    integer, save :: OMP_CHUNK
     
  contains
@@ -19 +21 @@
     subroutine init_parallel
     USE vampir
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+    USE mod_prism_proto
+#endif
+#endif
     implicit none
     
@@ -25 +32 @@
       integer :: type_size
       integer, dimension(3) :: blocklen,type
+      integer :: comp_id
       
       
@@ -30 +38 @@
 #include "dimensions90.h"
 #include "paramet90.h"
-      
+
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+       call prism_init_comp_proto (comp_id, 'lmdz.x', ierr)
+       call prism_get_localcomm_proto(COMM_LMDZ,ierr)
+#endif
+#else      
       call MPI_INIT(ierr)
+      COMM_LMDZ=MPI_COMM_WORLD
+#endif
       call InitVampir
-      call MPI_COMM_SIZE(MPI_COMM_WORLD,mpi_size,ierr)
-      call MPI_COMM_RANK(MPI_COMM_WORLD,mpi_rank,ierr)
+      call MPI_COMM_SIZE(COMM_LMDZ,mpi_size,ierr)
+      call MPI_COMM_RANK(COMM_LMDZ,mpi_rank,ierr)
   
       
@@ -50 +66 @@
           print *," ---> diminuez le nombre de CPU ou augmentez la taille en lattitude"
           
-          call MPI_ABORT(MPI_COMM_WORLD,-1, ierr)
+          call MPI_ABORT(COMM_LMDZ,-1, ierr)
           
         endif
@@ -133 +149 @@
     
     subroutine Finalize_parallel
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+    use mod_prism_proto
+#endif
+#endif
     implicit none
 
@@ -144 +165 @@
       deallocate(jj_end_para)
       deallocate(jj_nb_para)
-      
+
+#ifdef CPP_COUPLE
+#ifdef CPP_PSMILE
+     call prism_terminate_proto(ierr)
+     IF (ierr .ne. PRISM_Ok) THEN
+       call abort_gcm('Finalize_parallel',' Probleme dans prism_terminate_proto ',1)
+     endif
+#endif
+#else         
       call MPI_FINALIZE(ierr)
+#endif
       
     end subroutine Finalize_parallel
-    
+        
     subroutine Pack_Data(Field,ij,ll,row,Buffer)
     implicit none
@@ -217 +247 @@
       INTEGER :: Buffer_size      
       
-      call MPI_Barrier(MPI_COMM_WORLD,ierr)
+      call MPI_Barrier(COMM_LMDZ,ierr)
       call VTb(VThallo)
       
@@ -253 +283 @@
         call PACK_Data(Field(ij_begin,1),ij,ll,down,Buffer_Send_up)
         call MPI_ISSEND(Buffer_send_up,Buffer_Size,MPI_REAL8,MPI_Rank-1,1,     &
-                        MPI_COMM_WORLD,Request(NbRequest),ierr)
+                        COMM_LMDZ,Request(NbRequest),ierr)
       ENDIF
   
@@ -264 +294 @@
         
         call MPI_ISSEND(Buffer_send_down,Buffer_Size,MPI_REAL8,MPI_Rank+1,1,     &
-                        MPI_COMM_WORLD,Request(NbRequest),ierr)
+                        COMM_LMDZ,Request(NbRequest),ierr)
       ENDIF
     
@@ -274 +304 @@
               
         call MPI_IRECV(Buffer_recv_up,Buffer_size,MPI_REAL8,MPI_Rank-1,1,  &
-                        MPI_COMM_WORLD,Request(NbRequest),ierr)
+                        COMM_LMDZ,Request(NbRequest),ierr)
      
        
@@ -285 +315 @@
         
         call MPI_IRECV(Buffer_recv_down,Buffer_size,MPI_REAL8,MPI_Rank+1,1,     &
-                        MPI_COMM_WORLD,Request(NbRequest),ierr)
+                        COMM_LMDZ,Request(NbRequest),ierr)
       
         
@@ -295 +325 @@
 
       call VTe(VThallo)
-      call MPI_Barrier(MPI_COMM_WORLD,ierr)
+      call MPI_Barrier(COMM_LMDZ,ierr)
       RETURN
       
@@ -349 +379 @@
       
       call MPI_GATHERV(Buffer_send,(min(ij_end,ij)-ij_begin+1)*ll,MPI_REAL8,   &
-                        Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,MPI_COMM_WORLD,ierr)
+                        Buffer_Recv,Recv_count,displ,MPI_REAL8,rank,COMM_LMDZ,ierr)
       
       if (MPI_Rank==rank) then                  
@@ -380 +410 @@
       
       call Gather_Field(Field,ij,ll,0)
-      call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,MPI_COMM_WORLD)
+      call MPI_BCAST(Field,ij*ll,MPI_REAL8,0,COMM_LMDZ,ierr)
       
     end subroutine AllGather_Field
@@ -395 +425 @@
       INTEGER :: ierr
       
-      call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,MPI_COMM_WORLD)
+      call MPI_BCAST(Field,ij*ll,MPI_REAL8,rank,COMM_LMDZ,ierr)
       
     end subroutine Broadcast_Field