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 10300 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2018-11-12T17:49:08+01:00 (5 years ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2b: add waiting time for mpp_min/max/sum, see #2133

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90

    r10297 r10300  
    169169 
    170170   ! timing summary report 
    171    REAL(wp), PUBLIC ::  waiting_time = 0._wp, compute_time = 0._wp, elapsed_time = 0._wp 
     171   REAL(wp), DIMENSION(2), PUBLIC ::  waiting_time = 0._wp 
     172   REAL(wp)              , PUBLIC ::  compute_time = 0._wp, elapsed_time = 0._wp 
    172173    
    173174   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
     
    596597       
    597598      IF ( ireq /= -1 ) THEN   ! get ld_switch(2) from ll_switch (from previous call) 
     599         IF( ln_timing ) CALL tic_tac(.TRUE., ld_global = .TRUE.) 
    598600         CALL mpi_wait(ireq, MPI_STATUS_IGNORE, ierror ) 
    599601         ld_switch(2) = ll_switch 
     602         IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 
    600603      ENDIF 
    601604      IF( .NOT. ldlast ) &     ! send ll_switch to be received on next call 
     
    14641467 
    14651468    
    1466    SUBROUTINE tic_tac (l_tic) 
    1467  
    1468     LOGICAL, INTENT(IN) :: l_tic 
    1469     REAL(wp), SAVE :: tic_wt, tic_ct = 0._wp 
     1469   SUBROUTINE tic_tac (ld_tic, ld_global) 
     1470 
     1471    LOGICAL,           INTENT(IN) :: ld_tic 
     1472    LOGICAL, OPTIONAL, INTENT(IN) :: ld_global 
     1473    REAL(wp), DIMENSION(2), SAVE :: tic_wt 
     1474    REAL(wp),               SAVE :: tic_ct = 0._wp 
     1475    INTEGER :: ii 
    14701476 
    14711477    IF( ncom_stp <= nit000 ) RETURN 
    14721478    IF( ncom_stp == nitend ) RETURN 
     1479    ii = 1 
     1480    IF( PRESENT( ld_global ) ) THEN 
     1481       IF( ld_global ) ii = 2 
     1482    END IF 
    14731483     
    14741484#if defined key_mpp_mpi 
    1475     IF ( l_tic ) THEN 
    1476        tic_wt = MPI_Wtime()                                                        ! start count tic->tac (waiting time) 
     1485    IF ( ld_tic ) THEN 
     1486       tic_wt(ii) = MPI_Wtime()                                                    ! start count tic->tac (waiting time) 
    14771487       IF ( tic_ct > 0.0_wp ) compute_time = compute_time + MPI_Wtime() - tic_ct   ! cumulate count tac->tic 
    14781488    ELSE 
    1479        waiting_time = waiting_time + MPI_Wtime() - tic_wt                          ! cumulate count tic->tac 
     1489       waiting_time(ii) = waiting_time(ii) + MPI_Wtime() - tic_wt(ii)              ! cumulate count tic->tac 
    14801490       tic_ct = MPI_Wtime()                                                        ! start count tac->tic (waiting time) 
    14811491    ENDIF 
Note: See TracChangeset for help on using the changeset viewer.