Changeset 10297 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90

Timestamp:

2018-11-12T16:20:57+01:00 (5 years ago)

Author:

smasson

Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2a: add report calls of mppmin/max/sum, see #2133

File:

• NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90 (modified) (3 diffs)

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

@@ -63 +63 @@
       INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
       INTEGER  ::   ierr
+      INTEGER  ::   icom_freq
       REAL(wp) ::   zland
       INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
@@ -153 +154 @@
       !
       IF( narea == 1 ) THEN
-         IF ( ncom_stp == nit000 ) THEN
+
+         ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
+         icom_freq = ncom_fsbc * ncom_dttrc
+         IF( MOD( MAX(ncom_fsbc,ncom_dttrc), MIN(ncom_fsbc,ncom_dttrc) ) == 0 ) icom_freq = MAX(ncom_fsbc,ncom_dttrc)
+         
+         IF ( ncom_stp == nit000+icom_freq ) THEN   ! avoid to count extra communications in potential initializations at nit000
             IF( .NOT. ALLOCATED( ncomm_sequence) ) THEN
                ALLOCATE( ncomm_sequence(2000,2), STAT=ierr )
                IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate ncomm_sequence' )
-               ALLOCATE( crname(2000), STAT=ierr )
+               ALLOCATE( crname_lbc(2000), STAT=ierr )
                IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lnk_generic, cannot allocate crname' )
             ENDIF
-            n_sequence = n_sequence + 1
-            IF( n_sequence > 2000 ) CALL ctl_stop( 'STOP', 'lnk_generic, increase ncomm_sequence first dimension' )
-            ncomm_sequence(n_sequence,1) = ipk*ipl   ! size of 3rd and 4th dimensions
-            ncomm_sequence(n_sequence,2) = ipf       ! number of arrays to be treated (multi)
-            crname(n_sequence) = cdname              ! keep the name of the calling routine
-         ELSE IF ( ncom_stp == (nit000+1) ) THEN
-            IF ( .NOT. l_comm_report_done ) THEN
-               WRITE(numout,*) ' '
-               WRITE(numout,*) ' -----------------------------------------------'
-               WRITE(numout,*) ' Communication pattern report (first time step):'
-               WRITE(numout,*) ' -----------------------------------------------'
-               WRITE(numout,*) ' '
-               WRITE(numout,'(A,I4)') ' Exchanged halos : ', n_sequence
+            n_sequence_lbc = n_sequence_lbc + 1
+            IF( n_sequence_lbc > 2000 ) CALL ctl_stop( 'STOP', 'lnk_generic, increase ncomm_sequence first dimension' )
+            ncomm_sequence(n_sequence_lbc,1) = ipk*ipl   ! size of 3rd and 4th dimensions
+            ncomm_sequence(n_sequence_lbc,2) = ipf       ! number of arrays to be treated (multi)
+            crname_lbc    (n_sequence_lbc)   = cdname    ! keep the name of the calling routine
+         ELSE IF ( ncom_stp == (nit000+2*icom_freq) ) THEN
+            IF ( numcom == -1 ) THEN
+               CALL ctl_opn( numcom, 'communication_report.txt', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea )
+               WRITE(numcom,*) ' '
+               WRITE(numcom,*) ' ------------------------------------------------------------'
+               WRITE(numcom,*) ' Communication pattern report (second oce+sbc+top time step):'
+               WRITE(numcom,*) ' ------------------------------------------------------------'
+               WRITE(numcom,*) ' '
+               WRITE(numcom,'(A,I4)') ' Exchanged halos : ', n_sequence_lbc
                jj = 0; jk = 0; jf = 0; jh = 0
-               DO ji = 1, n_sequence
+               DO ji = 1, n_sequence_lbc
                   IF ( ncomm_sequence(ji,1) .GT. 1 ) jk = jk + 1
                   IF ( ncomm_sequence(ji,2) .GT. 1 ) jf = jf + 1
@@ -180 +187 @@
                   jh = MAX (jh, ncomm_sequence(ji,1)*ncomm_sequence(ji,2))
                END DO
-               WRITE(numout,'(A,I3)') ' 3D Exchanged halos : ', jk
-               WRITE(numout,'(A,I3)') ' Multi arrays exchanged halos : ', jf
-               WRITE(numout,'(A,I3)') '   from which 3D : ', jj
-               WRITE(numout,'(A,I10)') ' Array max size : ', jh*jpi*jpj
-               WRITE(numout,*) ' '
-               WRITE(numout,*) ' lbc_lnk called'
+               WRITE(numcom,'(A,I3)') ' 3D Exchanged halos : ', jk
+               WRITE(numcom,'(A,I3)') ' Multi arrays exchanged halos : ', jf
+               WRITE(numcom,'(A,I3)') '   from which 3D : ', jj
+               WRITE(numcom,'(A,I10)') ' Array max size : ', jh*jpi*jpj
+               WRITE(numcom,*) ' '
+               WRITE(numcom,*) ' lbc_lnk called'
                jj = 1
-               DO ji = 2, n_sequence
-                  IF( crname(ji-1) /= crname(ji) ) THEN
-                    WRITE(numout,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname(ji-1))
+               DO ji = 2, n_sequence_lbc
+                  IF( crname_lbc(ji-1) /= crname_lbc(ji) ) THEN
+                    WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(ji-1))
                     jj = 0
                   END IF
                   jj = jj + 1 
                END DO
-               WRITE(numout,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname(n_sequence))
-               WRITE(numout,*) ' '
-               WRITE(numout,*) ' -----------------------------------------------'
-               WRITE(numout,*) ' '
+               WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc))
+               WRITE(numcom,*) ' '
+               IF ( n_sequence_glb > 0 ) THEN
+                  WRITE(numcom,'(A,I4)') ' Global communications : ', n_sequence_glb
+                  jj = 1
+                  DO ji = 2, n_sequence_glb
+                     IF( crname_glb(ji-1) /= crname_glb(ji) ) THEN
+                       WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(ji-1))
+                       jj = 0
+                     END IF
+                     jj = jj + 1 
+                  END DO
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_glb(n_sequence_glb))
+                  DEALLOCATE(crname_glb)
+               ELSE
+                  WRITE(numcom,*) ' No MPI global communication '
+               ENDIF
+               WRITE(numcom,*) ' '
+               WRITE(numcom,*) ' -----------------------------------------------'
+               WRITE(numcom,*) ' '
                DEALLOCATE(ncomm_sequence)
-               DEALLOCATE(crname)
-               l_comm_report_done = .TRUE.
+               DEALLOCATE(crname_lbc)
             ENDIF
          ENDIF