Changeset 9772 for NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/mpp_lnk_generic.h90

Timestamp:

2018-06-08T14:52:48+02:00 (6 years ago)

Author:

smasson

Message:

dev_r9759_HPC09_ESIWACE: add benchmark features

File:

• NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/mpp_lnk_generic.h90 (modified) (2 diffs)

NEMO/branches/2018/dev_r9759_HPC09_ESIWACE/src/OCE/LBC/mpp_lnk_generic.h90

@@ -150 +150 @@
       imigr = nn_hls * jpj * ipk * ipl * ipf
       !
-      SELECT CASE ( nbondi )
-      CASE ( -1 )
-         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
-         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
-         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
-      CASE ( 0 )
-         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
-         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
-         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
-         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
-         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
-      CASE ( 1 )
-         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
-         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
-         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
-      END SELECT
+      IF ( ncom_stp == nit000 ) then
+         n_sequence = n_sequence + 1
+         icomm_sequence(n_sequence,1) = ipk
+         icomm_sequence(n_sequence,2) = ipf
+         ! write(6,'(A,6I4)') 'size comm ', nn_hls, jpi, jpj, ipk, ipl, ipf
+      ELSE IF ( mpprank == 0 .AND. ncom_stp == (nit000+1) .AND. l_print_comm_report ) THEN
+         write(6,*) 'Communication pattern report : '
+         write(6,*) ' '
+         write(6,'(A,I3)') ' Exchanged halos : ', n_sequence
+         jj = 0; jk = 0; jf = 0; jh = 0
+         DO ji = 1, n_sequence
+           IF ( icomm_sequence(ji,1) .gt. 1 ) jk = jk + 1
+           IF ( icomm_sequence(ji,2) .gt. 1 ) jf = jf + 1
+           IF ( icomm_sequence(ji,1) .gt. 1 .AND. icomm_sequence(ji,2) .gt. 1 ) jj = jj + 1
+           jh = MAX (jh, icomm_sequence(ji,1)*icomm_sequence(ji,2))
+         END DO
+         write(6,'(A,I3)') ' 3D Exchanged halos : ', jk
+         write(6,'(A,I3)') ' Multi arrays exchanged halos : ', jf
+         write(6,'(A,I3)') '   from which 3D : ', jj
+         write(6,'(A,I10)') ' array max size : ', jh*jpi*jpj
+         l_print_comm_report = .FALSE.
+      END IF
+      !
+      IF (ncom_stp <= ( nit000 + 1 ) .or. mod(ncom_stp,nn_comm_mod) == 0 ) THEN
+         !
+         CALL tic_tac(.TRUE.)
+         !
+         SELECT CASE ( nbondi )
+         CASE ( -1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+         CASE ( 0 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
+            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
+            IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
+         CASE ( 1 )
+            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
+            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
+            IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         END SELECT
+      END IF
       !
       !                           ! Write Dirichlet lateral conditions
@@ -226 +254 @@
       imigr = nn_hls * jpi * ipk * ipl * ipf
       !
-      SELECT CASE ( nbondj )
-      CASE ( -1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
-         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
-         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
-      CASE ( 0 )
-         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
-         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
-         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
-         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
-         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
-      CASE ( 1 )
-         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
-         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
-         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
-      END SELECT
+      IF (ncom_stp <= ( nit000 + 1 ) .or. mod(ncom_stp,nn_comm_mod) == 0 ) THEN
+ 
+         SELECT CASE ( nbondj )
+         CASE ( -1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         CASE ( 0 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
+            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+            IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
+         CASE ( 1 )
+            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
+            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
+            IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
+         END SELECT
+         ! imbalance measurement
+         CALL tic_tac(.FALSE.)
+         !
+      END IF
       !
       !                           ! Write Dirichlet lateral conditions