New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10437 – NEMO

Changeset 10437


Ignore:
Timestamp:
2018-12-21T11:18:36+01:00 (5 years ago)
Author:
smasson
Message:

trunk: improve communication_report.txt for delayed global comm

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r10428 r10437  
    153153   ! Communications summary report 
    154154   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_lbc                   !: names of lbc_lnk calling routines 
    155    CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm  calling routines 
     155   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_glb                   !: names of global comm calling routines 
     156   CHARACTER(len=128), DIMENSION(:), ALLOCATABLE ::   crname_dlg                   !: names of delayed global comm calling routines 
    156157   INTEGER, PUBLIC                               ::   ncom_stp = 0                 !: copy of time step # istp 
    157158   INTEGER, PUBLIC                               ::   ncom_fsbc = 1                !: copy of sbc time step # nn_fsbc 
     
    162163   INTEGER, PUBLIC                               ::   n_sequence_lbc = 0           !: # of communicated arraysvia lbc 
    163164   INTEGER, PUBLIC                               ::   n_sequence_glb = 0           !: # of global communications 
     165   INTEGER, PUBLIC                               ::   n_sequence_dlg = 0           !: # of delayed global communications 
    164166   INTEGER, PUBLIC                               ::   numcom = -1                  !: logical unit for communicaton report 
    165167   LOGICAL, PUBLIC                               ::   l_full_nf_update = .TRUE.    !: logical for a full (2lines) update of bc at North fold report 
     
    603605      isz = SIZE(y_in) 
    604606       
    605       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 
     607      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. ) 
    606608 
    607609      idvar = -1 
     
    664666      isz = SIZE(p_in) 
    665667 
    666       IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_glb = .TRUE. ) 
     668      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ld_dlg = .TRUE. ) 
    667669 
    668670      idvar = -1 
     
    14521454 
    14531455 
    1454    SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb ) 
     1456   SUBROUTINE mpp_report( cdname, kpk, kpl, kpf, ld_lbc, ld_glb, ld_dlg ) 
    14551457      !!---------------------------------------------------------------------- 
    14561458      !!                  ***  routine mpp_report  *** 
     
    14611463      CHARACTER(len=*),           INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    14621464      INTEGER         , OPTIONAL, INTENT(in   ) ::   kpk, kpl, kpf 
    1463       LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb 
    1464       !! 
    1465       LOGICAL ::   ll_lbc, ll_glb 
     1465      LOGICAL         , OPTIONAL, INTENT(in   ) ::   ld_lbc, ld_glb, ld_dlg 
     1466      !! 
     1467      LOGICAL ::   ll_lbc, ll_glb, ll_dlg 
    14661468      INTEGER ::    ji,  jj,  jk,  jh, jf   ! dummy loop indices 
    14671469      !!---------------------------------------------------------------------- 
     
    14711473      ll_glb = .FALSE. 
    14721474      IF( PRESENT(ld_glb) ) ll_glb = ld_glb 
     1475      ll_dlg = .FALSE. 
     1476      IF( PRESENT(ld_dlg) ) ll_dlg = ld_dlg 
    14731477      ! 
    14741478      ! find the smallest common frequency: default = frequency product, if multiple, choose the larger of the 2 frequency 
     
    14911495            IF( n_sequence_glb > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock 
    14921496            crname_glb(n_sequence_glb) = cdname     ! keep the name of the calling routine 
     1497         ENDIF 
     1498         IF( ll_dlg ) THEN 
     1499            IF( .NOT. ALLOCATED(crname_dlg) ) ALLOCATE( crname_dlg(ncom_rec_max) ) 
     1500            n_sequence_dlg = n_sequence_dlg + 1 
     1501            IF( n_sequence_dlg > ncom_rec_max ) CALL ctl_stop( 'STOP', 'lib_mpp, increase ncom_rec_max' )   ! deadlock 
     1502            crname_dlg(n_sequence_dlg) = cdname     ! keep the name of the calling routine 
    14931503         ENDIF 
    14941504      ELSE IF ( ncom_stp == nit000+2*ncom_freq ) THEN 
     
    15391549         ENDIF 
    15401550         WRITE(numcom,*) ' ' 
     1551         IF ( n_sequence_dlg > 0 ) THEN 
     1552            WRITE(numcom,'(A,I4)') ' Delayed global communications : ', n_sequence_dlg 
     1553            jj = 1 
     1554            DO ji = 2, n_sequence_dlg 
     1555               IF( crname_dlg(ji-1) /= crname_dlg(ji) ) THEN 
     1556                  WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(ji-1)) 
     1557                  jj = 0 
     1558               END IF 
     1559               jj = jj + 1  
     1560            END DO 
     1561            WRITE(numcom,'(A, I4, A, A)') ' - ', jj,' times by subroutine ', TRIM(crname_dlg(n_sequence_dlg)) 
     1562            DEALLOCATE(crname_dlg) 
     1563         ELSE 
     1564            WRITE(numcom,*) ' No MPI delayed global communication ' 
     1565         ENDIF 
     1566         WRITE(numcom,*) ' ' 
    15411567         WRITE(numcom,*) ' -----------------------------------------------' 
    15421568         WRITE(numcom,*) ' ' 
Note: See TracChangeset for help on using the changeset viewer.