- add timed sections on the go

- print aggregates

src/Distributed/MpiRouter.f90

@@ -4,7 +4,7 @@ module MpiRouterModule
   use CpuTimerModule, only: g_timer
   use STLVecIntModule
   use SimVariablesModule, only: proc_id, nr_procs
-  use SimStagesModule, only: STG_TO_STR
+  use SimStagesModule, only: STG_TO_STR, NR_SIM_STAGES
   use VirtualDataListsModule, only: virtual_model_list, &
                                     virtual_exchange_list
   use VirtualBaseModule, only: NR_VDC_ELEMENT_MAPS
@@ -33,6 +33,7 @@ module MpiRouterModule
     type(MpiWorldType), pointer :: mpi_world => null()
     integer(I4B) :: imon !< the output file unit for the mpi monitor
     logical(LGP) :: enable_monitor !< when true, log diagnostics
+    integer(I4B), dimension(:,:), allocatable :: tmr_mpi_wait !< array with timer handles for MPI_Wait calls
   contains
     procedure :: initialize => mr_initialize
     procedure :: route_all => mr_route_all
@@ -74,6 +75,10 @@ subroutine mr_initialize(this)
     class(VirtualDataContainerType), pointer :: vdc
     character(len=LINELENGTH) :: monitor_file
 
+    ! allocate timer handles: global + nr. solutions
+    allocate (this%tmr_mpi_wait(NR_SIM_STAGES, this%nr_virt_solutions + 1))
+    this%tmr_mpi_wait = -1
+
     ! routing over all when starting
     this%halo_activated = .false.
 
@@ -323,7 +328,10 @@ subroutine route_active(this, unit, stage)
     end do
 
     ! wait for exchange of all messages
+    call g_timer%start("MPI_WaitAll ("//trim(STG_TO_STR(stage))//")", &
+                       this%tmr_mpi_wait(stage, unit + 1))
     call MPI_WaitAll(this%senders%size, rcv_req, rcv_stat, ierr)
+    call g_timer%stop(this%tmr_mpi_wait(stage, unit + 1))
     call CHECK_MPI(ierr)
 
     deallocate (rcv_req, snd_req, rcv_stat)
@@ -439,7 +447,10 @@ subroutine compose_messages(this, unit, stage, body_snd_t, body_rcv_t)
     end do
 
     ! wait for exchange of all headers
+    call g_timer%start("MPI_WaitAll ("//trim(STG_TO_STR(stage))//")", &
+                       this%tmr_mpi_wait(stage, unit + 1))
     call MPI_WaitAll(this%receivers%size, rcv_req, rcv_stat, ierr)
+    call g_timer%stop(this%tmr_mpi_wait(stage, unit + 1))
     call CHECK_MPI(ierr)
 
     ! reinit handles
@@ -509,7 +520,10 @@ subroutine compose_messages(this, unit, stage, body_snd_t, body_rcv_t)
     end do
 
     ! wait on receiving maps
+    call g_timer%start("MPI_WaitAll ("//trim(STG_TO_STR(stage))//")", &
+                       this%tmr_mpi_wait(stage, unit + 1))
     call MPI_WaitAll(this%receivers%size, rcv_req, rcv_stat, ierr)
+    call g_timer%stop(this%tmr_mpi_wait(stage, unit + 1))
     call CHECK_MPI(ierr)
 
     ! print maps
@@ -713,6 +727,8 @@ subroutine mr_destroy(this)
     deallocate (this%all_models)
     deallocate (this%all_exchanges)
 
+    deallocate (this%tmr_mpi_wait)
+
   end subroutine mr_destroy
 
 end module MpiRouterModule

src/Distributed/MpiRunControl.F90

@@ -58,10 +58,10 @@ subroutine mpi_ctrl_start(this)
     tmr_func => mpi_walltime
     call set_timer_func(tmr_func)
     call g_timer%initialize()
-    tmr_init_par = g_timer%add_section("Init parallel", SECTION_INIT)
-    call g_timer%start(SECTION_RUN)
-    call g_timer%start(SECTION_INIT)
-    call g_timer%start(tmr_init_par)
+    call g_timer%start("Run", SECTION_RUN)
+    call g_timer%start("Initialize", SECTION_INIT)
+    tmr_init_par = -1
+    call g_timer%start("Initialize parallel", tmr_init_par)
 
     ! set mpi abort function
     pstop_alternative => mpi_stop
@@ -147,8 +147,8 @@ subroutine mpi_ctrl_finish(this)
     integer(I4B) :: tmr_final_par
 
     ! timer
-    tmr_final_par = g_timer%add_section("Finalize parallel", SECTION_FINALIZE)
-    call g_timer%start(tmr_final_par)
+    tmr_final_par = -1
+    call g_timer%start("Finalize parallel", tmr_final_par)
 
     ! finish mpi
 #if defined(__WITH_PETSC__)

src/Distributed/RouterBase.f90

@@ -6,6 +6,7 @@ module RouterBaseModule
 
   type, abstract, public :: RouterBaseType
     logical(LGP) :: halo_activated !< when true, the halo has been activated
+    integer(I4B) :: nr_virt_solutions !< number of virtual solution to be routed
     !< (allowing more efficient routing of virtual data)
   contains
     procedure(initialize_if), deferred :: initialize

src/Distributed/RouterFactory.F90

@@ -1,4 +1,5 @@
 module RouterFactoryModule
+  use KindModule, only: I4B
   use RouterBaseModule
   use SerialRouterModule, only: create_serial_router
 #if defined(__WITH_MPI__)
@@ -15,15 +16,18 @@ module RouterFactoryModule
   !! simulation mode (parallel or sequential) and type
   !! of build (with or without mpi)
   !<
-  function create_router(sim_mode) result(router)
+  function create_router(sim_mode, nr_sols) result(router)
     character(len=*) :: sim_mode !< simulation mode: SEQUENTIAL or PARALLEL
+    integer(I4B) :: nr_sols !< nr. of solutions
     class(RouterBaseType), pointer :: router !< the router object
 
     if (sim_mode == 'SEQUENTIAL') then
       router => create_serial_router()
+      router%nr_virt_solutions = nr_sols
 #if defined(__WITH_MPI__)
     else if (sim_mode == 'PARALLEL') then
       router => create_mpi_router()
+      router%nr_virt_solutions = nr_sols
 #endif
     else
       router => null()

src/Distributed/VirtualDataManager.f90

@@ -66,7 +66,7 @@ subroutine vds_create(this, sim_mode)
     this%nr_solutions = 0
 
     ! create a router, sequential or parallel
-    this%router => create_router(sim_mode)
+    this%router => create_router(sim_mode, nr_sol)
 
   end subroutine vds_create
 

src/RunControl.f90

@@ -20,6 +20,7 @@ module RunControlModule
     procedure :: at_stage => ctrl_at_stage
     procedure :: finish => ctrl_finish
     procedure :: after_con_cr => ctrl_after_con_cr
+
     ! private
     procedure, private :: init_handler
     procedure, private :: before_con_df
@@ -42,8 +43,8 @@ subroutine ctrl_start(this)
     ! initialize and start timers, if not done so in the derived class
     if (.not. g_timer%is_initialized()) then
       call g_timer%initialize()
-      call g_timer%start(SECTION_RUN)
-      call g_timer%start(SECTION_INIT)
+      call g_timer%start("Run", SECTION_RUN)
+      call g_timer%start("Initialize", SECTION_INIT)
     end if
 
     allocate (this%virtual_data_mgr)

src/Solution/NumericalSolution.f90

@@ -135,6 +135,7 @@ module NumericalSolutionModule
     integer(I4B) :: tmr_final_solve !< timer - finalize solve
     integer(I4B) :: tmr_formulate !< timer - formulate
     integer(I4B) :: tmr_linsolve !< timer - linear solve
+    character(len=24) :: id_postfix !< solution id based postfix for timer titles
     !
     ! -- adaptive time step
     real(DP), pointer :: atsfrac => null() !< adaptive time step faction
@@ -434,7 +435,6 @@ subroutine sln_df(this)
     integer(I4B), allocatable, dimension(:) :: rowmaxnnz
     integer(I4B) :: ncol, irow_start, irow_end
     integer(I4B) :: mod_offset
-    character(len=LEN_SECTION_TITLE) :: sec_title
     !
     ! -- set sol id and determine nr. of equation in this solution
     do i = 1, this%modellist%Count()
@@ -504,15 +504,12 @@ subroutine sln_df(this)
     call this%sln_connect()
 
     ! add timers
-    write(sec_title,'(a,i0,a)') "Prepare solve (", this%id, ")"
-    this%tmr_prep_solve = g_timer%add_section(sec_title, SECTION_DO_TSTP)
-    write(sec_title,'(a,i0,a)') "Solve (", this%id, ")"
-    this%tmr_solve = g_timer%add_section(sec_title, SECTION_DO_TSTP)
-    write(sec_title,'(a,i0,a)') "Finalize solve (", this%id, ")"
-    this%tmr_final_solve = g_timer%add_section(sec_title, SECTION_DO_TSTP)
-
-    this%tmr_formulate = g_timer%add_section("Formulate", this%tmr_solve)
-    this%tmr_linsolve = g_timer%add_section("Linear solve", this%tmr_solve)
+    write(this%id_postfix,'(a,i0,a)') " (", this%id, ")"
+    this%tmr_prep_solve = -1
+    this%tmr_solve = -1
+    this%tmr_final_solve = -1
+    this%tmr_formulate = -1
+    this%tmr_linsolve = -1
 
   end subroutine sln_df
 
@@ -1443,7 +1440,7 @@ subroutine prepareSolve(this)
     class(NumericalModelType), pointer :: mp => null()
 
     ! start timer
-    call g_timer%start(this%tmr_prep_solve)
+    call g_timer%start("Prepare solve"//this%id_postfix, this%tmr_prep_solve)
 
     ! synchronize for AD
     call this%synchronize(STG_BFR_EXG_AD, this%synchronize_ctx)
@@ -1522,7 +1519,7 @@ subroutine solve(this, kiter)
     real(DP) :: outer_hncg
 
     ! start timer
-    call g_timer%start(this%tmr_solve)
+    call g_timer%start("Solve"//this%id_postfix, this%tmr_solve)
 
     !
     ! -- initialize local variables
@@ -1577,7 +1574,7 @@ subroutine solve(this, kiter)
     end if
     !
     call code_timer(0, ttform, this%ttform)
-    call g_timer%start(this%tmr_formulate)
+    call g_timer%start("Formulate", this%tmr_formulate)
     !
     ! -- (re)build the solution matrix
     call this%sln_buildsystem(kiter, inewton=1)
@@ -1595,7 +1592,7 @@ subroutine solve(this, kiter)
     !
     ! -- linear solve
     call code_timer(0, ttsoln, this%ttsoln)
-    call g_timer%start(this%tmr_linsolve)
+    call g_timer%start("Linear solve", this%tmr_linsolve)
     call this%sln_ls(kiter, kstp, kper, iter, iptc, ptcf)
     call g_timer%stop(this%tmr_linsolve)
     call code_timer(1, ttsoln, this%ttsoln)
@@ -1861,7 +1858,7 @@ subroutine finalizeSolve(this, kiter, isgcnvg, isuppress_output)
       &' STRESS PERIOD ',I0,/1X,I0,' TOTAL ITERATIONS')"
 
     ! start timer
-    call g_timer%start(this%tmr_final_solve)
+    call g_timer%start("Finalize solve"//this%id_postfix, this%tmr_final_solve)
 
     !
     ! -- finalize the outer iteration table

src/Utilities/STLVecInt.f90

@@ -17,6 +17,7 @@ module STLVecIntModule
     procedure, pass(this) :: init !< allocate memory, init size and capacity
     procedure, pass(this) :: push_back !< adds an element at the end of the vector
     procedure, pass(this) :: push_back_unique !< adds an element at the end of the vector, if not present yet
+    procedure, pass(this) :: pop !< removes the last element
     procedure, pass(this) :: add_array !< adds elements of array at the end of the vector
     procedure, pass(this) :: add_array_unique !< adds elements of array at the end of the vector, if not present yet
     procedure, pass(this) :: at !< random access, unsafe, no bounds checking
@@ -72,6 +73,18 @@ subroutine push_back_unique(this, newValue)
 
   end subroutine push_back_unique
 
+  subroutine pop(this)
+    class(STLVecInt), intent(inout) :: this
+
+    if (this%size > 0) then
+      this%size = this%size - 1
+    else
+      write (*, *) 'STLVecInt exception: cannot pop from an empty array'
+      call ustop()
+    end if
+
+  end subroutine
+
   subroutine add_array(this, array)
     class(STLVecInt), intent(inout) :: this
     integer(I4B), dimension(:), pointer :: array