Changeset 10437

Timestamp:

2018-12-21T11:18:36+01:00 (6 years ago)

Author:

smasson

Message:

trunk: improve communication_report.txt for delayed global comm

File:

• NEMO/trunk/src/OCE/LBC/lib_mpp.F90 (modified) (9 diffs)

NEMO/trunk/src/OCE/LBC/lib_mpp.F90

@@ -153 +153 @@
    ! Communications summary report
    CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines
-   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm  calling routines
+   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines
+   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines
    INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp
    INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc
@@ -162 +163 @@
    INTEGER, PUBLIC                               ::   n_sequence_lbc = 0           !: # of communicated arraysvia lbc
    INTEGER, PUBLIC                               ::   n_sequence_glb = 0           !: # of global communications
+   INTEGER, PUBLIC                               ::   n_sequence_dlg = 0           !: # of delayed global communications
    INTEGER, PUBLIC                               ::   numcom = -1                  !: logical unit for communicaton report
    LOGICAL, PUBLIC                               ::   l_full_nf_update = .TRUE.    !: logical for a full (2lines) update of bc at North fold report
@@ -603 +605 @@
       isz = SIZE(y_in)
       
-      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
 
       idvar = -1
@@ -664 +666 @@
       isz = SIZE(p_in)
 
-      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. )
+      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. )
 
       idvar = -1
@@ -1452 +1454 @@
 
 
-   SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb )
+   SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb, ld_dlg )
       !!----------------------------------------------------------------------
       !!                  ***  routine mpp_report  ***
@@ -1461 +1463 @@
       CHARACTER(len=*),           INTENT(in   ) ::   cdname      ! name of the calling subroutine
       INTEGER         , OPTIONAL, INTENT(in   ) ::   kpk, kpl, kpf
-      LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb
-      !!
-      LOGICAL ::   ll_lbc, ll_glb
+      LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb, ld_dlg
+      !!
+      LOGICAL ::   ll_lbc, ll_glb, ll_dlg
       INTEGER ::    ji,  jj,  jk,  jh, jf   ! dummy loop indices
       !!----------------------------------------------------------------------
@@ -1471 +1473 @@
       ll_glb = .FALSE.
       IF( PRESENT(ld_glb) ) ll_glb = ld_glb
+      ll_dlg = .FALSE.
+      IF( PRESENT(ld_dlg) ) ll_dlg = ld_dlg
       !
       ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency
@@ -1491 +1495 @@
             IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
             crname_glb(n_sequence_glb) = cdname     ! keep the name of the calling routine
+         ENDIF
+         IF( ll_dlg ) THEN
+            IF( .NOT. ALLOCATED(crname_dlg) ) ALLOCATE( crname_dlg(ncom_rec_max) )
+            n_sequence_dlg = n_sequence_dlg + 1
+            IF( n_sequence_dlg > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock
+            crname_dlg(n_sequence_dlg) = cdname     ! keep the name of the calling routine
          ENDIF
       ELSE IF ( ncom_stp == nit000+2*ncom_freq ) THEN
@@ -1539 +1549 @@
          ENDIF
          WRITE(numcom,*) ' '
+         IF ( n_sequence_dlg > 0 ) THEN
+            WRITE(numcom,'(A,I4)') ' Delayed global communications : ', n_sequence_dlg
+            jj = 1
+            DO ji = 2, n_sequence_dlg
+               IF( crname_dlg(ji-1) /= crname_dlg(ji) ) THEN
+                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(ji-1))
+                  jj = 0
+               END IF
+               jj = jj + 1 
+            END DO
+            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg))
+            DEALLOCATE(crname_dlg)
+         ELSE
+            WRITE(numcom,*) ' No MPI delayed global communication '
+         ENDIF
+         WRITE(numcom,*) ' '
          WRITE(numcom,*) ' -----------------------------------------------'
          WRITE(numcom,*) ' '