Changeset 327 for codes/icosagcm/trunk/src/domain.f90

Timestamp:

02/09/15 20:18:34 (9 years ago)

Author:

ymipsl

Message:

Merge recent developments from saturn branch onto trunk.

• lmdz generic physics interface
• performance improvment on mix mpi/openmp
• asynchrone and overlaping communication
• best domain distribution between process and threads
• ....

This version is compatible with the actual saturn version and the both branches are considered merged on dynamico component.

YM

File:

• codes/icosagcm/trunk/src/domain.f90 (modified) (3 diffs)

codes/icosagcm/trunk/src/domain.f90

@@ -402 +402 @@
   SUBROUTINE assign_domain
   USE mpipara
+  USE grid_param
   IMPLICIT NONE
     INTEGER :: nb_domain(0:mpi_size-1)
     INTEGER :: rank, ind,ind_glo
+    INTEGER :: block_j,jb,i,j,nd_glo,n,nf
+    LOGICAL :: exit
     
     DO rank=0,mpi_size-1
@@ -415 +418 @@
     ALLOCATE(domloc_glo_ind(ndomain))
     
+    
+    block_j=sqrt(nsplit_i*nsplit_j*nb_face*1./mpi_size)
+    exit=.FALSE.
+    jb=1
+    i=1
+    j=1
+    ind=1
+    nd_glo=0
     rank=0
-    ind=0
-    DO ind_glo=1,ndomain_glo
-      ind=ind+1
+    DO WHILE (.NOT. exit)
+
+      IF (j==MIN(jb+block_j,nsplit_j*nb_face+1)) THEN
+        j=jb
+        i=i+1
+      ENDIF
+
+      IF (i>nsplit_i) THEN 
+        i=1
+        jb=jb+block_j
+        j=jb
+      ENDIF
+      
+      IF (ind>nb_domain(rank)) THEN
+        rank=rank+1
+        ind=1
+      ENDIF 
+      ind_glo=(j-1)*nsplit_i+i
+
+      nd_glo=nd_glo+1
+      IF (nd_glo==ndomain_glo) THEN
+
+        exit=.TRUE.
+        IF (.NOT. (rank==mpi_size-1 .AND. ind==nb_domain(rank) )) THEN
+          PRINT *, "Distribution problem in assign_domain"
+          STOP
+        ENDIF
+
+      ENDIF
+
       domglo_rank(ind_glo)=rank
       domglo_loc_ind(ind_glo)=ind
@@ -426 +464 @@
       ENDIF
       
-      IF (ind==nb_domain(rank)) THEN
-        rank=rank+1
-        ind=0
-      ENDIF
+      j=j+1
+      ind=ind+1
+      
     ENDDO
+
+    IF (is_mpi_master) THEN
+   
+      ind_glo=0
+      WRITE(*,'')
+      PRINT*, '      MPI PROCESS DISTRIBUTION'
+      WRITE(*,'')
+      
+      WRITE(*,"(' ')", ADVANCE='NO')
+      DO n=1,nsplit_i*7-1
+        WRITE(*,"('=')", ADVANCE='NO')
+      ENDDO
+      WRITE(*,'')
+
+      DO nf=1,nb_face
+        DO j=1,nsplit_j
+          IF (j>1) THEN
+            WRITE(*,"(' ')", ADVANCE='NO')
+            DO n=1,nsplit_i*7-1
+              WRITE(*,"('-')", ADVANCE='NO')
+            ENDDO
+            WRITE(*,'')
+          ENDIF
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
+          ENDDO
+          WRITE(*,'')
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            ind_glo=ind_glo+1
+            WRITE(*,"(' ',i4.4  ,' |')",ADVANCE='NO'),domglo_rank(ind_glo)           
+          END DO
+          WRITE(*,'')
+
+          WRITE(*,"('|')", ADVANCE='NO')
+          DO i=1,nsplit_i
+            WRITE(*,"(' ','    ',' |')",ADVANCE='NO')         
+          ENDDO
+          WRITE(*,'')
+
+        ENDDO
+          
+        WRITE(*,"(' ')", ADVANCE='NO')
+        DO n=1,nsplit_i*7-1
+          WRITE(*,"('=')", ADVANCE='NO')
+        ENDDO
+        WRITE(*,'')
+      ENDDO
+    ENDIF
+              
+!    rank=0
+!    ind=0
+!    DO ind_glo=1,ndomain_glo
+!      ind=ind+1
+!      domglo_rank(ind_glo)=rank
+!      domglo_loc_ind(ind_glo)=ind
+!      IF (rank==mpi_rank) THEN 
+!        CALL copy_domain(domain_glo(ind_glo),domain(ind))
+!        domloc_glo_ind(ind)=ind_glo
+!      ENDIF
+!      
+!      IF (ind==nb_domain(rank)) THEN
+!        rank=rank+1
+!        ind=0
+!      ENDIF
+!    ENDDO
 
 !$OMP PARALLEL