diff --git a/source/sfincs_lib/sfincs_lib.vfproj b/source/sfincs_lib/sfincs_lib.vfproj index 9e9cac55a..c8793d50d 100644 --- a/source/sfincs_lib/sfincs_lib.vfproj +++ b/source/sfincs_lib/sfincs_lib.vfproj @@ -109,6 +109,7 @@ + diff --git a/source/src/Makefile.am b/source/src/Makefile.am index 1aa72660e..5e5bd1034 100644 --- a/source/src/Makefile.am +++ b/source/src/Makefile.am @@ -49,6 +49,7 @@ libsfincs_la_SOURCES = \ ../third_party_open/utils/toml-f/src/tomlf/build.f90 \ ../third_party_open/utils/toml-f/src/tomlf/all.f90 \ ../third_party_open/utils/toml-f/src/tomlf.f90 \ + sfincs_timers.f90 \ sfincs_log.f90 \ sfincs_date.f90 \ sfincs_read.f90 \ diff --git a/source/src/sfincs_bathtub.f90 b/source/src/sfincs_bathtub.f90 index 76e1c60f9..4f67e2b61 100644 --- a/source/src/sfincs_bathtub.f90 +++ b/source/src/sfincs_bathtub.f90 @@ -114,23 +114,18 @@ subroutine initialize_bathtub() end subroutine - subroutine bathtub_compute_water_levels(tloop) + subroutine bathtub_compute_water_levels() ! use sfincs_data + use sfincs_timers use geometry ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! integer :: nm, i1, i2 real*4 :: zbt, w1, w2 ! - call system_clock(count0, count_rate, count_max) + call timer_start('continuity') ! !$omp parallel & !$omp private ( nm, i1, i2, w1, w2 ) @@ -168,8 +163,7 @@ subroutine bathtub_compute_water_levels(tloop) ! !$acc update device( zs, zsmax ) ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0 * (count1 - count0) / count_rate + call timer_stop('continuity') ! end subroutine diff --git a/source/src/sfincs_boundaries.f90 b/source/src/sfincs_boundaries.f90 index 34d8d64c5..82a6c469d 100644 --- a/source/src/sfincs_boundaries.f90 +++ b/source/src/sfincs_boundaries.f90 @@ -1123,26 +1123,21 @@ subroutine update_boundary_fluxes(dt, t) - subroutine update_boundaries(t, dt, tloop) + subroutine update_boundaries(t, dt) ! ! Update all boundary conditions ! use sfincs_data + use sfincs_timers ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! real*8 :: t real*4 :: dt ! - call system_clock(count0, count_rate, count_max) - ! if (boundaries_in_mask) then + ! + call timer_start('boundaries') ! if (nbnd > 0) then ! @@ -1156,7 +1151,7 @@ subroutine update_boundaries(t, dt, tloop) ! as these are not used in bathtub mode ! if (.not. bathtub) then - ! + ! ! Update boundary conditions at grid points (water levels) ! call update_boundary_conditions(t, dt) @@ -1167,11 +1162,10 @@ subroutine update_boundaries(t, dt, tloop) ! endif ! + call timer_stop('boundaries') + ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0 * (count1 - count0) / count_rate - ! end subroutine ! ! diff --git a/source/src/sfincs_continuity.f90 b/source/src/sfincs_continuity.f90 index 592477666..dbe8f9e26 100644 --- a/source/src/sfincs_continuity.f90 +++ b/source/src/sfincs_continuity.f90 @@ -2,22 +2,18 @@ module sfincs_continuity contains - subroutine compute_water_levels(t, dt, tloop) + subroutine compute_water_levels(t, dt) ! use sfincs_data + use sfincs_timers ! implicit none ! real*4 :: dt real*8 :: t ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop ! - call system_clock(count0, count_rate, count_max) + call timer_start('continuity') ! if (subgrid) then ! @@ -37,8 +33,7 @@ subroutine compute_water_levels(t, dt, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('continuity') ! end subroutine diff --git a/source/src/sfincs_data.f90 b/source/src/sfincs_data.f90 index 534757471..3dff491e5 100644 --- a/source/src/sfincs_data.f90 +++ b/source/src/sfincs_data.f90 @@ -4,7 +4,6 @@ module sfincs_data character*256 :: build_revision, build_date !!!! !!! Time variables - real :: tstart_all, tfinish_all real*4 :: dtavg real*4 :: min_dt !!! @@ -34,8 +33,6 @@ module sfincs_data real*4 gn2 real*4 t0 real*4 t1 - real*4 t3 - real*4 t4 real*4 dx real*4 dy real*4 dxinv diff --git a/source/src/sfincs_date.f90 b/source/src/sfincs_date.f90 index ec732196d..6988958d1 100644 --- a/source/src/sfincs_date.f90 +++ b/source/src/sfincs_date.f90 @@ -365,7 +365,7 @@ function time_to_vector(t_sec, tref_string) result (date_time_vector) ! subroutine timer(t) real*4,intent(out) :: t - integer*4 :: count,count_rate,count_max + integer*8 :: count,count_rate,count_max call system_clock (count,count_rate,count_max) t = dble(count)/count_rate end subroutine timer diff --git a/source/src/sfincs_discharges.f90 b/source/src/sfincs_discharges.f90 index 2d3a7262f..461d16bae 100644 --- a/source/src/sfincs_discharges.f90 +++ b/source/src/sfincs_discharges.f90 @@ -10,6 +10,7 @@ subroutine read_discharges() ! Reads discharge files ! use sfincs_data + use sfincs_timers use sfincs_ncinput use quadtree ! @@ -322,7 +323,7 @@ subroutine read_discharges() ! ! ! - subroutine update_discharges(t, dt, tloop) + subroutine update_discharges(t, dt) ! ! Update discharges ! @@ -330,11 +331,6 @@ subroutine update_discharges(t, dt, tloop) ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop ! real*8 :: t real*4 :: dt @@ -346,7 +342,7 @@ subroutine update_discharges(t, dt, tloop) ! integer isrc, itsrc, idrn, jin, jout, nmin, nmout ! - call system_clock(count0, count_rate, count_max) + call timer_start('discharges') ! ! Compute instantaneous discharges from point sources ! @@ -654,8 +650,7 @@ subroutine update_discharges(t, dt, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0 * (count1 - count0) / count_rate + call timer_stop('discharges') ! end subroutine diff --git a/source/src/sfincs_infiltration.f90 b/source/src/sfincs_infiltration.f90 index 147004080..e4f6c3e4f 100644 --- a/source/src/sfincs_infiltration.f90 +++ b/source/src/sfincs_infiltration.f90 @@ -8,6 +8,7 @@ module sfincs_infiltration subroutine initialize_infiltration() ! use sfincs_data + use sfincs_timers use sfincs_ncinput ! implicit none @@ -604,7 +605,7 @@ subroutine initialize_infiltration() end subroutine - subroutine update_infiltration_map(dt, tloop) + subroutine update_infiltration_map(dt) ! ! Update infiltration rates in each grid cell ! @@ -619,13 +620,8 @@ subroutine update_infiltration_map(dt, tloop) real*4 :: hh_local, a real*4 :: dt ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop ! - call system_clock(count0, count_rate, count_max) + call timer_start('infiltration') ! if (inftype == 'con' .or. inftype == 'c2d') then ! @@ -1031,8 +1027,7 @@ subroutine update_infiltration_map(dt, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0 * (count1 - count0) / count_rate + call timer_stop('infiltration') ! end subroutine diff --git a/source/src/sfincs_lib.f90 b/source/src/sfincs_lib.f90 index a2fd05da9..016017035 100644 --- a/source/src/sfincs_lib.f90 +++ b/source/src/sfincs_lib.f90 @@ -26,6 +26,7 @@ module sfincs_lib use sfincs_bathtub use sfincs_openacc use sfincs_log + use sfincs_timers use sfincs_timestep_analysis ! implicit none @@ -41,13 +42,6 @@ module sfincs_lib ! private ! - integer*8 :: count0 - integer*8 :: count00 - integer*8 :: countdt0 - integer*8 :: countdt1 - integer*8 :: count1 - integer*8 :: count_rate - integer*8 :: count_max integer :: nt ! integer :: ntmapout @@ -75,10 +69,7 @@ module sfincs_lib logical :: update_meteo logical :: update_waves ! - real :: tstart, tfinish, tloopflux, tloopcont, tloopstruc, tloopbnd, tloopsrc, tloopwnd1, tloopwnd2, tloopinf, tloopoutput, tloopsnapwave, tloopwavemaker, tloopnonh real :: time_per_timestep - real :: tinput - real :: percdone,percdonenext,trun,trem ! contains ! @@ -97,44 +88,9 @@ function sfincs_initialize() result(ierr) build_revision = "$Rev: v2.4.0 Galibier+" build_date = "$Date: 2026-07-13" ! - call write_log('', 1) - call write_log('------------ Welcome to SFINCS ------------', 1) - call write_log('', 1) - call write_log(' @@@@@ @@@@@@@ @@ @@ @@ @@@@ @@@@@ ', 1) - call write_log(' @@@ @@@ @@@@@@@ @@ @@@ @@ @@@@@@@ @@@ @@@', 1) - call write_log(' @@@ @@ @@ @@@ @@ @@ @@ @@@ ', 1) - call write_log(' @@@@@ @@@@@@ @@ @@@@@@ @@ @@@@@ ', 1) - call write_log(' @@@ @@ @@ @@ @@@ @@ @@ @@@', 1) - call write_log(' @@@ @@@ @@ @@ @@ @@ @@@@@@ @@@ @@@', 1) - call write_log(' @@@@@ @@ @@ @@ @ @@@@ @@@@@ ', 1) - call write_log('', 1) - call write_log(' .............. ', 1) - call write_log(' ......:@@@@@@@@:...... ', 1) - call write_log(' ..::::..@@........@@.:::::.. ', 1) - call write_log(' ..:::::..@@..::..::..@@.::::::.. ', 1) - call write_log(' .::::::..@@............@@.:::::::. ', 1) - call write_log(' .::::::..@@..............@@.:::::::. ', 1) - call write_log(' .::::::::..@@............@@..::::::::. ', 1) - call write_log(' .:::::::::...@@.@..@@..@.@@..::::::::::. ', 1) - call write_log(' .:::::::::...:@@@..@@..@@@:..:::::::::.. ', 1) - call write_log(' ............@@.@@..@@..@@.@@............ ', 1) - call write_log(' ^^^~~^^~~^^@@..............@@^^^~^^^~~^^ ', 1) - call write_log(' .::::::::::@@..............@@.:::::::::. ', 1) - call write_log(' .......:.@@.....@.....@....@@.:....... ', 1) - call write_log(' .::....@@......@.@@@.@....@@.....::. ', 1) - call write_log(' .:::~@@.:...:.@@...@@.:.:.@@~::::. ', 1) - call write_log(' .::~@@@@@@@@@@.....@@@@@@@@@~::. ', 1) - call write_log(' ..:~~~~~~~:.......:~~~~~~~:.. ', 1) - call write_log(' ...................... ', 1) - call write_log(' .............. ', 1) - call write_log('', 1) - call write_log('------------------------------------------', 1) - call write_log('', 1) - call write_log('Build-Revision: '//trim(build_revision), 1) - call write_log('Build-Date: '//trim(build_date), 1) - call write_log('', 1) + call write_startup_log() ! - call system_clock(count0, count_rate, count_max) + call timer_start('input') ! call write_log('------ Preparing model simulation --------', 1) call write_log('', 1) @@ -150,7 +106,8 @@ function sfincs_initialize() result(ierr) ! endif ! - call write_log('Preparing domain ...', 0) + call write_log('Preparing domain ...', 0) + ! call initialize_domain() ! Reads dep, msk, index files, creates index, flag and depth arrays, initializes hydro quantities ! call read_structures() ! Reads thd files and sets kcuv to zero where necessary @@ -191,78 +148,6 @@ function sfincs_initialize() result(ierr) ! endif ! - call write_log('', 1) - call write_log('------------------------------------------', 1) - call write_log('Processes', 1) - call write_log('------------------------------------------', 1) - if (subgrid) then - call write_log('Subgrid topography : yes', 1) - else - call write_log('Subgrid topography : no', 1) - endif - if (use_quadtree) then - call write_log('Quadtree refinement : yes', 1) - else - call write_log('Quadtree refinement : no', 1) - endif - if (advection) then - call write_log('Advection : yes', 1) - else - call write_log('Advection : no', 1) - endif - if (viscosity) then - call write_log('Viscosity : yes', 1) - else - call write_log('Viscosity : no', 1) - endif - if (coriolis) then - call write_log('Coriolis : yes', 1) - else - call write_log('Coriolis : no', 1) - endif - if (wind) then - call write_log('Wind : yes', 1) - else - call write_log('Wind : no', 1) - endif - if (patmos) then - call write_log('Atmospheric pressure : yes', 1) - else - call write_log('Atmospheric pressure : no', 1) - endif - if (precip) then - call write_log('Precipitation : yes', 1) - else - call write_log('Precipitation : no', 1) - endif - if (infiltration) then - call write_log('Infiltration : yes', 1) - else - call write_log('Infiltration : no', 1) - endif - if (snapwave) then - call write_log('SnapWave : yes', 1) - else - call write_log('SnapWave : no', 1) - endif - if (wavemaker) then - call write_log('Wave paddles : yes', 1) - else - call write_log('Wave paddles : no', 1) - endif - if (nonhydrostatic) then - call write_log('Non-hydrostatic : yes', 1) - else - ! call write_log('Non-hydrostatic : no', 1) - endif - if (bathtub) then - call write_log('Bathtub : yes', 1) - else - ! call write_log('Bathtub : no', 1) - endif - call write_log('------------------------------------------', 1) - call write_log('', 1) - ! if (snapwave) then ! call write_log('Coupling with SnapWave ...', 1) @@ -270,9 +155,9 @@ function sfincs_initialize() result(ierr) ! endif ! - call system_clock(count1, count_rate, count_max) + call timer_stop('input') ! - tinput = 1.0 * (count1 - count0) / count_rate + call write_processes_log() ! ! Initialize some parameters ! @@ -298,18 +183,6 @@ function sfincs_initialize() result(ierr) update_meteo = .false. ! update meteo fields update_waves = .false. ! update wave fields ! - tloopflux = 0.0 - tloopcont = 0.0 - tloopstruc = 0.0 - tloopbnd = 0.0 - tloopsrc = 0.0 - tloopwnd1 = 0.0 - tloopwnd2 = 0.0 - tloopinf = 0.0 - tloopsnapwave = 0.0 - tloopwavemaker = 0.0 - tloopnonh = 0.0 - ! call write_log('Initializing output ...', 0) ! call initialize_output(tmapout, tmaxout, thisout, trstout) @@ -328,7 +201,7 @@ function sfincs_initialize() result(ierr) call write_log(logstr, 1) call write_log('', 1) ! - call system_clock(count00, count_rate, count_max) + call timer_start('simulation') ! end function sfincs_initialize ! @@ -377,8 +250,6 @@ function sfincs_update(dtrange) result(ierr) ! Start computational loop ! do while (t < tend) - ! - call system_clock(countdt0, count_rate, count_max) ! write_map = .false. write_his = .false. @@ -404,11 +275,6 @@ function sfincs_update(dtrange) result(ierr) ! endif ! - ! A bit unclear why this happens, but large jumps in the time step lead to weird oscillations. - ! In the 'original' sfincs v11 version, this behavior was supressed by the use of theta. - ! Avoid this, by not not changing time step dt (used in momentum equation), but only changing dtt, - ! which is used in the time updating and continuity equation. - ! ! Update time ! t = t + dt @@ -433,11 +299,14 @@ function sfincs_update(dtrange) result(ierr) ntmaxout = ntmaxout + 1 ! now also keep track of nr of max output tout = max(tmaxout, t - dt) ! - if (t < t1) then - tmaxout = tmaxout + dtmaxout + if (t < t1) then + ! + tmaxout = tmaxout + dtmaxout + ! ! in case the last 'dt' made us exactly past tstop time 't1', ! then we don't want to flag later another dtmax output timestep in 'finalize_output' check, - ! so if t > t1 don't add 'dtmaxout' again + ! so if t > t1 don't add 'dtmaxout' again + ! endif ! endif @@ -521,13 +390,13 @@ function sfincs_update(dtrange) result(ierr) ! Update spatially-varying meteo (this does not happen every time step) ! Read and interpolate to grid ! - call update_meteo_fields(t, tloopwnd1) + call update_meteo_fields(t) ! endif ! ! Update forcing used in momentum and continuity equations (this does happen every time step) ! - call update_meteo_forcing(t, dt, tloopwnd2) + call update_meteo_forcing(t, dt) ! ! Update infiltration ! @@ -535,45 +404,35 @@ function sfincs_update(dtrange) result(ierr) ! ! Compute infiltration rates ! - call update_infiltration_map(dt, tloopinf) + call update_infiltration_map(dt) ! endif ! - endif + endif ! ! Update boundary conditions ! - call update_boundaries(t, dt, tloopbnd) + call update_boundaries(t, dt) ! ! Update discharges ! - call update_discharges(t, dt, tloopsrc) + call update_discharges(t, dt) + ! + ! Update SnapWave ! if (snapwave .and. update_waves) then ! - call timer(t3) - ! - call update_wave_field(t, tloopsnapwave) + ! Update wave fields from SnapWave coupling (this happens at intervals of dtwave) ! - call timer(t4) - write(logstr,'(a,f10.1,a,f6.2,a)')'Computing SnapWave at t = ', t, ' s took ', t4 - t3, ' seconds' - call write_log(logstr, 0) + call update_wave_field(t) ! - ! Maybe we'll add moving wave makers back at some point - ! - ! if (wavemaker) then - ! ! - ! call update_wavemaker_points(tloopwavemaker) - ! ! - ! endif - ! - endif + endif ! if (bathtub) then ! ! In bathtub mode, only update water levels based on boundary conditions ! - call bathtub_compute_water_levels(tloopcont) + call bathtub_compute_water_levels() ! else ! @@ -581,7 +440,7 @@ function sfincs_update(dtrange) result(ierr) ! ! First compute fluxes ! - call compute_fluxes(dt, tloopflux) + call compute_fluxes(dt) ! if (timestep_analysis) then ! @@ -591,13 +450,13 @@ function sfincs_update(dtrange) result(ierr) ! if (wavemaker) then ! - call update_wavemaker_fluxes(t, dt, tloopwavemaker) + call update_wavemaker_fluxes(t, dt) ! endif ! if (nrstructures>0) then ! - call compute_fluxes_over_structures(tloopstruc) + call compute_fluxes_over_structures() ! endif ! @@ -607,7 +466,7 @@ function sfincs_update(dtrange) result(ierr) ! ! Apply non-hydrostatic pressure corrections to q and uv ! - call compute_nonhydrostatic(dt, tloopnonh) + call compute_nonhydrostatic(dt) ! endif ! @@ -615,7 +474,7 @@ function sfincs_update(dtrange) result(ierr) ! ! Update water levels ! - call compute_water_levels(t, dt, tloopcont) + call compute_water_levels(t, dt) ! endif ! @@ -625,7 +484,7 @@ function sfincs_update(dtrange) result(ierr) ! ! if (.not. fixed_output_intervals) tout = t ! - call write_output(tout, write_map, write_his, write_max, write_rst, ntmapout, ntmaxout, nthisout, tloopoutput) + call write_output(tout, write_map, write_his, write_max, write_rst, ntmapout, ntmaxout, nthisout) ! endif ! @@ -641,33 +500,13 @@ function sfincs_update(dtrange) result(ierr) ! ntmaxout = ntmaxout + 1 ! Max sure that max output is not called again through 'finalize_output' ! - call write_output(t, .true., .true., .true., .false., ntmapout + 1, ntmaxout, nthisout + 1, tloopoutput) + call write_output(t, .true., .true., .true., .false., ntmapout + 1, ntmaxout, nthisout + 1) ! t = t1 + 1.0 ! endif ! - percdone = min(100 * (t - t0) / (t1 - t0), 100.0) - ! - if (percdone >= percdonenext) then - ! - ! percdoneval is increment of % to show to log, default=+5% - percdonenext = 1.0 * (int(percdone) + percdoneval) - ! - call system_clock(count1, count_rate, count_max) - ! - trun = 1.0*(count1 - count00)/count_rate - trem = trun / max(0.01*percdone, 1.0e-6) - trun - ! - if (int(percdone)>0) then - write(logstr,'(i4,a,f7.1,a)')int(percdone),'% complete, ',trem,' s remaining ...' - call write_log(logstr, 1) - else - write(logstr,'(i4,a,f7.1,a)')int(percdone),'% complete, - s remaining ...' - call write_log(logstr, 1) - endif - ! - endif + call write_progress_log(t, t0, t1) ! if (single_time_step) then ! @@ -688,114 +527,32 @@ function sfincs_finalize() result(ierr) ! integer :: ierr ! - call system_clock(count1, count_rate, count_max) - ! - tstart_all = 0.0 - tfinish_all = 1.0 * (count1 - count00) / count_rate + call timer_stop('simulation') ! if (timestep_analysis) then ! call timestep_analysis_finalize(nt) ! - endif + endif ! - call finalize_output(t, ntmaxout, tloopoutput, tmaxout) + call finalize_output(t, ntmaxout, tmaxout) ! call finalize_openacc() ! Exit data region ! dtavg = dtavg / (nt - 1) ! - call write_log('', 1) - call write_log('---------- Simulation finished -----------', 1) - call write_log('', 1) - write(logstr,'(a,f10.3)') ' Total time : ', tinput + tfinish_all - tstart_all - call write_log(logstr, 1) - write(logstr,'(a,f10.3)') ' Total simulation time : ', tfinish_all - tstart_all - call write_log(logstr, 1) - write(logstr,'(a,f10.3)') ' Time in input : ', tinput - call write_log(logstr, 1) - ! - if (boundaries_in_mask) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in boundaries : ', tloopbnd, ' (', 100 * tloopbnd / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (nsrc>0 .or. ndrn>0) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in discharges : ', tloopsrc, ' (', 100 * tloopsrc / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (meteo3d) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in meteo fields : ', tloopwnd1, ' (', 100 * tloopwnd1 / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (wind .or. patmos .or. precip) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in meteo forcing : ', tloopwnd2, ' (', 100 * tloopwnd2 / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (infiltration) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in infiltration : ', tloopinf, ' (', 100 * tloopinf / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in momentum : ', tloopflux, ' (', 100 * tloopflux / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - ! - if (nonhydrostatic) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in non-hydrostatic: ', tloopnonh, ' (', 100 * tloopnonh / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (nrstructures>0) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in structures : ', tloopstruc, ' (', 100 * tloopstruc / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in continuity : ', tloopcont, ' (', 100 * tloopcont / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - ! - if (snapwave) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in SnapWave : ', tloopsnapwave, ' (', 100 * tloopsnapwave / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - if (wavemaker) then - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in wave maker : ', tloopwavemaker, ' (', 100 * tloopwavemaker / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - endif - ! - write(logstr,'(a,f10.3,a,f5.1,a)') ' Time in output : ', tloopoutput, ' (', 100 * tloopoutput / (tfinish_all - tstart_all), '%)' - call write_log(logstr, 1) - ! - call write_log('', 1) - ! - write(logstr,'(a,20f10.3)') ' Average time step (s) : ', dtavg - call write_log(logstr, 1) - ! - call write_log('', 1) + call write_finished_log(dtavg) ! if (timestep_analysis) then ! call timestep_analysis_write_log() ! - endif + endif ! if (write_time_output) then - open(123,file='runtimes.txt') - write(123,'(f10.3,a)')tfinish_all - tstart_all,' % total' - write(123,'(f10.3,a)')tinput,' % input' - write(123,'(f10.3,a)')tloopbnd,' % boundaries' - write(123,'(f10.3,a)')tloopsrc,' % discharges' - write(123,'(f10.3,a)')tloopwnd1,' % meteo1' - write(123,'(f10.3,a)')tloopwnd2,' % meteo2' - write(123,'(f10.3,a)')tloopinf,' % infiltration' - write(123,'(f10.3,a)')tloopflux,' % momentum' - write(123,'(f10.3,a)')tloopstruc,' % structures' - write(123,'(f10.3,a)')tloopcont,' % continuity' - write(123,'(f10.3,a)')tloopoutput,' % output' - close(123) + ! + call write_runtimes_file(123, 'runtimes.txt') + ! endif ! call write_log('----------- Closing off SFINCS -----------', 1) diff --git a/source/src/sfincs_log.f90 b/source/src/sfincs_log.f90 index b78b7cd83..d93f9a167 100644 --- a/source/src/sfincs_log.f90 +++ b/source/src/sfincs_log.f90 @@ -1,40 +1,509 @@ module sfincs_log + ! + ! User-facing log / screen output for SFINCS. + ! + ! Owns sfincs.log (fid, open_log/close_log/write_log) and all the + ! formatted blocks that the driver writes to it. + ! + ! Rendering of named-timer data (headers, per-phase summary, the + ! runtimes.txt payload) also lives here, so that sfincs_timers can + ! remain a pure data module with no dependency on sfincs_log. This + ! breaks what used to be a circular dependency between the two. + ! + ! Subroutines: + ! + ! open_log() / close_log() / write_log(str, to_screen) + ! File handle management and the single-line writer. Called from + ! every SFINCS module that emits user-facing output. + ! + ! write_startup_log() + ! Welcome banner + ASCII logo + build-revision / build-date lines. + ! Called once from sfincs_initialize (sfincs_lib). + ! + ! write_processes_log() + ! "Processes" yes/no summary. Called once from sfincs_initialize. + ! + ! write_progress_log(t, t0, t1) + ! Per-timestep progress / ETA line. Called every time step from + ! the main loop in sfincs_lib. Uses timer_elapsed('simulation'). + ! + ! write_finished_log(dtavg) + ! End-of-run banner + per-phase timer summary + average time step. + ! Called once from sfincs_finalize (sfincs_lib). + ! + ! write_timer_headers_log(to_screen) + ! Three-line "Total / Total simulation / Input" header block. + ! Called from write_finished_log. + ! + ! write_timer_summary_log(to_screen, total_wall, min_elapsed) + ! Per-timer summary table (name, seconds, % of total, #calls). + ! Walks the timer list via the iteration API on sfincs_timers. + ! Called from write_finished_log. + ! + ! write_runtimes_file(unit, filename) + ! Writes the runtimes.txt payload (simulation-loop wall time, + ! input wall time, and each phase timer) in the format the + ! original inline code in sfincs_lib produced. Called from + ! sfincs_finalize (sfincs_lib) when write_time_output is set. + ! + ! fmt_real(val, decimals) result(s) + ! Format a real value with the minimum necessary field width and + ! a guaranteed leading zero for |val| < 1. Works around a quirk + ! in ifx that drops the leading zero for the "f0.d" edit + ! descriptor. Returns a 32-char string, left-justified; callers + ! use trim(fmt_real(...)) when embedding it in a larger format. + ! + use sfincs_timers ! integer :: fid character(256) :: logstr ! -contains - - subroutine open_log() + ! Next percentage threshold at which the progress reporter prints a + ! line. Incremented in steps of percdoneval (set from the + ! 'percentage_done' input keyword). Zero-initialised so the first + ! call prints at 0%. ! - implicit none + real, save :: percdonenext = 0.0 ! - fid = 777 - open(unit = fid, file = 'sfincs.log') +contains ! - end subroutine - - subroutine write_log(str, to_screen) + !-----------------------------------------------------------------------------------------------------! ! - implicit none + subroutine open_log() + ! + ! Open sfincs.log on the module-local unit fid=777. Called once + ! at the very start of sfincs_initialize (sfincs_lib). + ! + implicit none + ! + fid = 777 + open(unit = fid, file = 'sfincs.log') + ! + end subroutine open_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_log(str, to_screen) + ! + ! Write one line to sfincs.log, optionally echoed to stdout. + ! Called from every SFINCS module that emits user-facing output. + ! + implicit none + ! + character(*), intent(in) :: str + integer, intent(in) :: to_screen + ! + write(fid,'(a)') trim(str) + ! + if (to_screen == 1) then + write(*,'(a)') trim(str) + endif + ! + end subroutine write_log ! - character(*), intent(in) :: str - integer, intent(in) :: to_screen + !-----------------------------------------------------------------------------------------------------! ! - write(fid,'(a)')trim(str) + function fmt_real(val, decimals) result(s) + ! + ! Format a real with minimum width and a guaranteed leading zero + ! for |val| < 1. ifx's "f0.d" descriptor drops the leading zero in + ! that range, which is not standard-conforming; this helper rewrites + ! the result so the log output always reads "0.6670" rather than + ! ".6670". + ! + ! Use anywhere a real needs to be embedded in a log line with the + ! smallest reasonable field width. + ! + implicit none + ! + real, intent(in) :: val + integer, intent(in) :: decimals + character(len=32) :: s + ! + character(len=16) :: fmt + ! + write(fmt,'(a,i0,a)') '(f0.', decimals, ')' + write(s,fmt) val + s = adjustl(s) + ! + if (s(1:1) == '.') then + ! + s = '0' // s(1:len_trim(s)) + ! + else if (s(1:2) == '-.') then + ! + s = '-0' // trim(s(2:)) + ! + endif + ! + end function fmt_real ! - if (to_screen==1) then - write(*,'(a)')trim(str) - endif + !-----------------------------------------------------------------------------------------------------! ! - end subroutine - subroutine close_log() + ! + ! Close the sfincs.log file handle. Called once at the end of + ! sfincs_finalize (sfincs_lib). + ! + implicit none + ! + close(fid) + ! + end subroutine close_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_startup_log() + ! + ! Welcome banner, ASCII logo and build-revision / build-date lines. + ! Called once at the start of sfincs_initialize (sfincs_lib), + ! after build_revision and build_date have been set in sfincs_data. + ! + use sfincs_data + ! + implicit none + ! + call write_log('', 1) + call write_log('------------ Welcome to SFINCS ------------', 1) + call write_log('', 1) + call write_log(' @@@@@ @@@@@@@ @@ @@ @@ @@@@ @@@@@ ', 1) + call write_log(' @@@ @@@ @@@@@@@ @@ @@@ @@ @@@@@@@ @@@ @@@', 1) + call write_log(' @@@ @@ @@ @@@ @@ @@ @@ @@@ ', 1) + call write_log(' @@@@@ @@@@@@ @@ @@@@@@ @@ @@@@@ ', 1) + call write_log(' @@@ @@ @@ @@ @@@ @@ @@ @@@', 1) + call write_log(' @@@ @@@ @@ @@ @@ @@ @@@@@@ @@@ @@@', 1) + call write_log(' @@@@@ @@ @@ @@ @ @@@@ @@@@@ ', 1) + call write_log('', 1) + call write_log(' .............. ', 1) + call write_log(' ......:@@@@@@@@:...... ', 1) + call write_log(' ..::::..@@........@@.:::::.. ', 1) + call write_log(' ..:::::..@@..::..::..@@.::::::.. ', 1) + call write_log(' .::::::..@@............@@.:::::::. ', 1) + call write_log(' .::::::..@@..............@@.:::::::. ', 1) + call write_log(' .::::::::..@@............@@..::::::::. ', 1) + call write_log(' .:::::::::...@@.@..@@..@.@@..::::::::::. ', 1) + call write_log(' .:::::::::...:@@@..@@..@@@:..:::::::::.. ', 1) + call write_log(' ............@@.@@..@@..@@.@@............ ', 1) + call write_log(' ^^^~~^^~~^^@@..............@@^^^~^^^~~^^ ', 1) + call write_log(' .::::::::::@@..............@@.:::::::::. ', 1) + call write_log(' .......:.@@.....@.....@....@@.:....... ', 1) + call write_log(' .::....@@......@.@@@.@....@@.....::. ', 1) + call write_log(' .:::~@@.:...:.@@...@@.:.:.@@~::::. ', 1) + call write_log(' .::~@@@@@@@@@@.....@@@@@@@@@~::. ', 1) + call write_log(' ..:~~~~~~~:.......:~~~~~~~:.. ', 1) + call write_log(' ...................... ', 1) + call write_log(' .............. ', 1) + call write_log('', 1) + call write_log('------------------------------------------', 1) + call write_log('', 1) + call write_log('Build-Revision: '//trim(build_revision), 1) + call write_log('Build-Date: '//trim(build_date), 1) + call write_log('', 1) + ! + end subroutine write_startup_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_processes_log() + ! + ! "Processes" summary block listing which physical processes are + ! enabled for this run. Reads the process flags from sfincs_data. + ! Called once from sfincs_initialize (sfincs_lib). + ! + use sfincs_data + ! + implicit none + ! + call write_log('', 1) + call write_log('------------------------------------------', 1) + call write_log('Processes', 1) + call write_log('------------------------------------------', 1) + ! + if (subgrid) then + call write_log('Subgrid topography : yes', 1) + else + call write_log('Subgrid topography : no', 1) + endif + ! + if (use_quadtree) then + call write_log('Quadtree refinement : yes', 1) + else + call write_log('Quadtree refinement : no', 1) + endif + ! + if (advection) then + call write_log('Advection : yes', 1) + else + call write_log('Advection : no', 1) + endif + ! + if (viscosity) then + call write_log('Viscosity : yes', 1) + else + call write_log('Viscosity : no', 1) + endif + ! + if (coriolis) then + call write_log('Coriolis : yes', 1) + else + call write_log('Coriolis : no', 1) + endif + ! + if (wind) then + call write_log('Wind : yes', 1) + else + call write_log('Wind : no', 1) + endif + ! + if (patmos) then + call write_log('Atmospheric pressure : yes', 1) + else + call write_log('Atmospheric pressure : no', 1) + endif + ! + if (precip) then + call write_log('Precipitation : yes', 1) + else + call write_log('Precipitation : no', 1) + endif + ! + if (infiltration) then + call write_log('Infiltration : yes', 1) + else + call write_log('Infiltration : no', 1) + endif + ! + if (snapwave) then + call write_log('SnapWave : yes', 1) + else + call write_log('SnapWave : no', 1) + endif + ! + if (wavemaker) then + call write_log('Wave paddles : yes', 1) + else + call write_log('Wave paddles : no', 1) + endif + ! + if (nonhydrostatic) then + call write_log('Non-hydrostatic : yes', 1) + else + ! call write_log('Non-hydrostatic : no', 1) + endif + ! + if (bathtub) then + call write_log('Bathtub : yes', 1) + else + ! call write_log('Bathtub : no', 1) + endif + ! + call write_log('------------------------------------------', 1) + call write_log('', 1) + ! + end subroutine write_processes_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_progress_log(t, t0, t1) + ! + ! Per-timestep progress reporter. Prints a "NN% complete, TT.T s + ! remaining ..." line each time the simulated-time percentage + ! crosses the next percdoneval threshold. Remaining time is + ! estimated from the wall-clock elapsed in the 'simulation' + ! timer. + ! + ! Called every time step from the main loop in sfincs_lib. + ! + use sfincs_data, only: percdoneval + ! + implicit none + ! + real*8, intent(in) :: t + real*4, intent(in) :: t0, t1 + ! + real :: percdone, trun, trem + character(len=256) :: logstr + ! + percdone = min(100.0 * (real(t, 4) - t0) / (t1 - t0), 100.0) + ! + if (percdone >= percdonenext) then + ! + ! percdoneval is increment of % to show to log, default=+5% + ! + percdonenext = 1.0 * (int(percdone) + percdoneval) + ! + trun = real(timer_elapsed('simulation'), 4) + trem = trun / max(0.01*percdone, 1.0e-6) - trun + ! + if (int(percdone) > 0) then + ! + write(logstr,'(i4,a,f7.1,a)') int(percdone),'% complete, ',trem,' s remaining ...' + call write_log(logstr, 1) + ! + else + ! + write(logstr,'(i4,a,f7.1,a)') int(percdone),'% complete, - s remaining ...' + call write_log(logstr, 1) + ! + endif + ! + endif + ! + end subroutine write_progress_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_finished_log(dtavg) + ! + ! End-of-run log block: "Simulation finished" banner, per-phase + ! timer summary, and the average time step line. Called once from + ! sfincs_finalize (sfincs_lib), after the simulation loop has + ! stopped and dtavg has been averaged. + ! + implicit none + ! + real, intent(in) :: dtavg + ! + character(len=256) :: logstr + ! + call write_log('', 1) + call write_log('---------- Simulation finished -----------', 1) + call write_log('', 1) + ! + call write_timer_headers_log(1) + ! + ! Per-phase timing summary. Percentages are relative to the total + ! wall time of the simulation loop. + ! + call write_timer_summary_log(1, timer_elapsed('simulation'), 0.0005_8) + ! + call write_log('', 1) + ! + write(logstr,'(a,20f10.3)') ' Average time step (s) : ', dtavg + call write_log(logstr, 1) + ! + call write_log('', 1) + ! + end subroutine write_finished_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_timer_headers_log(to_screen) + ! + ! Write the three 'Total time / Total simulation time / Time in input' header + ! lines to the log, using the 'input' and 'simulation' named timers. + ! + ! Called from: write_finished_log. + ! + integer, intent(in) :: to_screen + ! + real(8) :: t_input + real(8) :: t_loop + ! + t_input = timer_elapsed('input') + t_loop = timer_elapsed('simulation') + ! + write(logstr, '(a,f10.3)') ' Total time : ', t_input + t_loop + call write_log(trim(logstr), to_screen) + ! +! write(logstr, '(a,f10.3)') ' Total simulation time : ', t_loop +! call write_log(trim(logstr), to_screen) + ! + write(logstr, '(a,f10.3)') ' Time in input : ', t_input + call write_log(trim(logstr), to_screen) + ! + end subroutine write_timer_headers_log + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine write_timer_summary_log(to_screen, total_wall, min_elapsed) + ! + ! Pretty-print a summary of all registered timers via write_log. + ! Walks the timer list via the iteration API on sfincs_timers + ! (timer_num_registered, timer_name_by_index, timer_elapsed_by_index, + ! timer_count_by_index) so this module does not need to know about + ! the internal storage of sfincs_timers. + ! + ! to_screen : passed to write_log (1 = also echo to stdout). + ! total_wall : reference total wall time used for the '%' column. + ! If <= 0, the sum across all timers is used instead. + ! min_elapsed : timers with accumulated time below this threshold (in s) + ! are skipped. Pass a negative value to print every timer. + ! + ! Called from: write_finished_log. + ! + integer, intent(in) :: to_screen + real(8), intent(in) :: total_wall + real(8), intent(in) :: min_elapsed + ! + real(8) :: denom + real(8) :: t_el + real(8) :: pct + integer :: i + integer :: n + character(32) :: tname + character(256) :: line + ! + if (total_wall > 0.0_8) then + denom = total_wall + else + denom = max(timer_total_wall(), 1.0e-12_8) + endif + ! + n = timer_num_registered() + ! + do i = 1, n + ! + t_el = timer_elapsed_by_index(i) + ! + if (t_el < min_elapsed) cycle + ! + ! Skip input (was already added in header) + ! + if (trim(timer_name_by_index(i)) == 'input') cycle + ! + pct = 100.0_8 * t_el / denom + tname = timer_name_by_index(i) + ! + write(line, '(1x,a,1x,a,t31,a,f10.3,a,f5.1,a)') & + 'Time in', trim(tname), ': ', t_el, ' (', pct, '%)' + ! + call write_log(trim(line), to_screen) + ! + enddo + ! + end subroutine write_timer_summary_log ! - implicit none + !-----------------------------------------------------------------------------------------------------! ! - close(fid) + subroutine write_runtimes_file(unit, filename) + ! + ! Write the runtimes.txt payload: simulation-loop wall time, input wall time, + ! and each phase timer, in the same order and with the same keys as the + ! previous inline implementation in sfincs_lib.f90. + ! + ! Called from: sfincs_finalize (sfincs_lib) when write_time_output + ! is set. + ! + integer, intent(in) :: unit + character(len=*), intent(in) :: filename + ! + open(unit, file=filename) + ! + write(unit, '(f10.3,a)') real(timer_elapsed('simulation'), 4), ' % total' + write(unit, '(f10.3,a)') real(timer_elapsed('input'), 4), ' % input' + write(unit, '(f10.3,a)') real(timer_elapsed('boundaries'), 4), ' % boundaries' + write(unit, '(f10.3,a)') real(timer_elapsed('discharges'), 4), ' % discharges' + write(unit, '(f10.3,a)') real(timer_elapsed('meteo fields'), 4), ' % meteo1' + write(unit, '(f10.3,a)') real(timer_elapsed('meteo forcing'), 4), ' % meteo2' + write(unit, '(f10.3,a)') real(timer_elapsed('infiltration'), 4), ' % infiltration' + write(unit, '(f10.3,a)') real(timer_elapsed('momentum'), 4), ' % momentum' + write(unit, '(f10.3,a)') real(timer_elapsed('structures'), 4), ' % structures' + write(unit, '(f10.3,a)') real(timer_elapsed('continuity'), 4), ' % continuity' + write(unit, '(f10.3,a)') real(timer_elapsed('output'), 4), ' % output' + ! + close(unit) + ! + end subroutine write_runtimes_file ! - end subroutine - -end module +end module sfincs_log diff --git a/source/src/sfincs_meteo.f90 b/source/src/sfincs_meteo.f90 index 7e40d2df5..3022aec5f 100644 --- a/source/src/sfincs_meteo.f90 +++ b/source/src/sfincs_meteo.f90 @@ -1230,20 +1230,15 @@ subroutine update_ampr_data() end subroutine - subroutine update_meteo_forcing(t, dt, tloop) + subroutine update_meteo_forcing(t, dt) ! ! Update wind stresses and precipitation (this happens every time step) ! use sfincs_data + use sfincs_timers ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! real*8 :: t real*4 :: dt real*4 :: twfact @@ -1252,7 +1247,7 @@ subroutine update_meteo_forcing(t, dt, tloop) real*4 :: oneminsmfac integer :: nm, ib ! - call system_clock(count0, count_rate, count_max) + call timer_start('meteo forcing') ! if (meteo3d) then ! @@ -1423,8 +1418,7 @@ subroutine update_meteo_forcing(t, dt, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0 * (count1 - count0) / count_rate + call timer_stop('meteo forcing') ! end subroutine @@ -1545,25 +1539,20 @@ subroutine update_precipitation_from_timeseries(t, dt) end subroutine - subroutine update_meteo_fields(t, tloop) + subroutine update_meteo_fields(t) ! ! Update values at boundary points ! use sfincs_data + use sfincs_timers ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! integer :: nm ! real*8 :: t ! - call system_clock(count0, count_rate, count_max) + call timer_start('meteo fields') ! if (amufile(1:4) /= 'none' .or. netamuamvfile(1:4) /= 'none') then ! @@ -1605,8 +1594,7 @@ subroutine update_meteo_fields(t, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('meteo fields') ! end subroutine diff --git a/source/src/sfincs_momentum.f90 b/source/src/sfincs_momentum.f90 index 66f9a2192..04e941f66 100644 --- a/source/src/sfincs_momentum.f90 +++ b/source/src/sfincs_momentum.f90 @@ -1,21 +1,16 @@ module sfincs_momentum ! use sfincs_data + use sfincs_timers ! implicit none ! contains ! - subroutine compute_fluxes(dt, tloop) + subroutine compute_fluxes(dt) ! ! Computes fluxes over subgrid u and v points ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! real*4 :: dt ! integer :: ip @@ -94,7 +89,7 @@ subroutine compute_fluxes(dt, tloop) ! logical :: iok ! - call system_clock(count0, count_rate, count_max) + call timer_start('momentum') ! min_dt = dtmax ! @@ -738,6 +733,7 @@ subroutine compute_fluxes(dt, tloop) ! timestep_analysis_required_timestep(ip) = min_dt_ip ! + endif ! else @@ -778,10 +774,9 @@ subroutine compute_fluxes(dt, tloop) ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('momentum') ! - end subroutine + end subroutine ! ! function power7over3(hu) result(hu73) diff --git a/source/src/sfincs_ncoutput.F90 b/source/src/sfincs_ncoutput.F90 index 04427c938..c65e11ad1 100644 --- a/source/src/sfincs_ncoutput.F90 +++ b/source/src/sfincs_ncoutput.F90 @@ -1537,6 +1537,7 @@ subroutine ncoutput_map_finalize() ! Add total runtime, dtavg to file and close ! use sfincs_data + use sfincs_timers, only: timer_elapsed ! implicit none ! @@ -1552,7 +1553,7 @@ subroutine ncoutput_map_finalize() ! endif ! - NF90(nf90_put_var(map_file%ncid, map_file%total_runtime_varid, tfinish_all - tstart_all)) + NF90(nf90_put_var(map_file%ncid, map_file%total_runtime_varid, real(timer_elapsed('simulation'), 4))) NF90(nf90_put_var(map_file%ncid, map_file%average_dt_varid, dtavg)) NF90(nf90_put_var(map_file%ncid, map_file%status_varid, error)) ! @@ -1567,6 +1568,7 @@ subroutine ncoutput_his_finalize() ! Add total runtime, dtavg to file and close ! use sfincs_data + use sfincs_timers, only: timer_elapsed ! implicit none ! @@ -1578,7 +1580,7 @@ subroutine ncoutput_his_finalize() return endif ! - NF90(nf90_put_var(his_file%ncid, his_file%total_runtime_varid, tfinish_all - tstart_all)) + NF90(nf90_put_var(his_file%ncid, his_file%total_runtime_varid, real(timer_elapsed('simulation'), 4))) NF90(nf90_put_var(his_file%ncid, his_file%average_dt_varid, dtavg)) NF90(nf90_put_var(his_file%ncid, his_file%status_varid, error)) ! diff --git a/source/src/sfincs_nonhydrostatic.f90 b/source/src/sfincs_nonhydrostatic.f90 index 6200a1b5b..e8214f830 100644 --- a/source/src/sfincs_nonhydrostatic.f90 +++ b/source/src/sfincs_nonhydrostatic.f90 @@ -388,21 +388,16 @@ subroutine initialize_nonhydrostatic() end subroutine - subroutine compute_nonhydrostatic(dt, tloop) + subroutine compute_nonhydrostatic(dt) ! - ! Non-hydrostatic pressure correction on fluxes and velocities + ! Non-hydrostatic pressure correction on fluxes and velocities ! use sfincs_data + use sfincs_timers use bicgstab_solver_ilu ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! real*4 :: dt ! integer :: ip @@ -439,7 +434,7 @@ subroutine compute_nonhydrostatic(dt, tloop) real*4, dimension(:), allocatable :: AA real*4 :: relres ! - call system_clock(count0, count_rate, count_max) + call timer_start('non-hydrostatic') ! allocate(QQ(nrows)) allocate(AA(nr_vals_in_matrix)) @@ -738,9 +733,8 @@ subroutine compute_nonhydrostatic(dt, tloop) !$omp end do !$omp end parallel ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('non-hydrostatic') ! - end subroutine + end subroutine end module diff --git a/source/src/sfincs_output.f90 b/source/src/sfincs_output.f90 index bacd6750f..d754b01af 100644 --- a/source/src/sfincs_output.f90 +++ b/source/src/sfincs_output.f90 @@ -8,6 +8,7 @@ module sfincs_output subroutine initialize_output(tmapout,tmaxout,thisout, trstout) ! use sfincs_data + use sfincs_timers ! implicit none ! @@ -77,17 +78,12 @@ subroutine initialize_output(tmapout,tmaxout,thisout, trstout) end subroutine - subroutine write_output(t,write_map,write_his,write_max,write_rst,ntmapout,ntmaxout,nthisout,tloop) + subroutine write_output(t,write_map,write_his,write_max,write_rst,ntmapout,ntmaxout,nthisout) ! use sfincs_data ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop ! logical :: write_map logical :: write_max @@ -100,7 +96,7 @@ subroutine write_output(t,write_map,write_his,write_max,write_rst,ntmapout,ntmax ! real*8 :: t ! - call system_clock(count0, count_rate, count_max) + call timer_start('output') ! ! Time-varying water level output maps ! @@ -252,12 +248,11 @@ subroutine write_output(t,write_map,write_his,write_max,write_rst,ntmapout,ntmax ! endif ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('output') ! end subroutine - subroutine finalize_output(t, ntmaxout, tloopoutput, tmaxout) + subroutine finalize_output(t, ntmaxout, tmaxout) ! use sfincs_data ! @@ -265,7 +260,6 @@ subroutine finalize_output(t, ntmaxout, tloopoutput, tmaxout) ! integer :: ntmaxout real*8 :: t, t2 - real :: tloopoutput real*8 :: tmaxout ! if (dtmaxout>1.e-6 .and. ntmaxout == 0) then @@ -275,7 +269,7 @@ subroutine finalize_output(t, ntmaxout, tloopoutput, tmaxout) call write_log('', 1) call write_log('Info : Write maximum values at final timestep since t=dtmaxout was not reached yet...', 1) ntmaxout = 1 - call write_output(t,.false.,.false.,.true.,.false.,0,ntmaxout,0,tloopoutput) + call write_output(t,.false.,.false.,.true.,.false.,0,ntmaxout,0) ! elseif (dtmaxout>1.e-6 .and. ntmaxout>0 .and. t < tmaxout) then ! @@ -286,7 +280,7 @@ subroutine finalize_output(t, ntmaxout, tloopoutput, tmaxout) ! Write 'tstop' as timemax instead of actual (unrounded) 't' t2 = t1 ! - call write_output(t2,.false.,.false.,.true.,.false.,0,ntmaxout,0,tloopoutput) + call write_output(t2,.false.,.false.,.true.,.false.,0,ntmaxout,0) ! endif ! diff --git a/source/src/sfincs_snapwave.f90 b/source/src/sfincs_snapwave.f90 index ef3b157b2..c6a35cf4d 100644 --- a/source/src/sfincs_snapwave.f90 +++ b/source/src/sfincs_snapwave.f90 @@ -285,26 +285,25 @@ subroutine find_matching_cells(index_quadtree_in_snapwave, index_snapwave_in_qua end subroutine - subroutine update_wave_field(t, tloop) + subroutine update_wave_field(t) ! use sfincs_data + use sfincs_timers + use omp_lib ! implicit none ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! real*4 :: u10, u10dir - ! + ! real*4, dimension(:), allocatable :: fwx0 real*4, dimension(:), allocatable :: fwy0 integer :: ip, nm, nmu, idir real*8 :: t + real(8) :: t3, t4 ! - call system_clock(count0, count_rate, count_max) + t3 = omp_get_wtime() + ! + call timer_start('SnapWave') ! allocate(fwx0(np)) allocate(fwy0(np)) @@ -440,10 +439,14 @@ subroutine update_wave_field(t, tloop) !$acc update device(fwuv) ! ! Set wave forces fwmaxfac factor - fwmaxfac = snapwave_fwmaxfac + fwmaxfac = snapwave_fwmaxfac + ! + call timer_stop('SnapWave') + ! + t4 = omp_get_wtime() ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + write(logstr,'(a,f10.1,a,f6.2,a)')'Computing SnapWave at t = ', t, ' s took ', t4 - t3, ' seconds' + call write_log(logstr, 0) ! end subroutine diff --git a/source/src/sfincs_structures.f90 b/source/src/sfincs_structures.f90 index bc51ffa1b..e4a2ffb9e 100644 --- a/source/src/sfincs_structures.f90 +++ b/source/src/sfincs_structures.f90 @@ -589,11 +589,12 @@ subroutine give_thindam_information(struc_info) end subroutine - subroutine compute_fluxes_over_structures(tloop) + subroutine compute_fluxes_over_structures() ! ! Computes fluxes over structures (THIS HAS TO BE SERIOUSLY IMPROVED!!!) ! use sfincs_data + use sfincs_timers ! use quadtree ! implicit none @@ -614,13 +615,7 @@ subroutine compute_fluxes_over_structures(tloop) real*4 :: h2 real*4 :: qstruc ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! - call system_clock(count0, count_rate, count_max) + call timer_start('structures') ! !$acc parallel, present(zs, q, uv, structure_uv_index, uv_index_z_nm, uv_index_z_nmu, structure_parameters, structure_type, structure_length) !$acc loop independent gang vector @@ -691,9 +686,8 @@ subroutine compute_fluxes_over_structures(tloop) enddo !$acc end parallel ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate - ! + call timer_stop('structures') + ! end subroutine diff --git a/source/src/sfincs_timers.f90 b/source/src/sfincs_timers.f90 new file mode 100644 index 000000000..77d91d13b --- /dev/null +++ b/source/src/sfincs_timers.f90 @@ -0,0 +1,407 @@ +module sfincs_timers + ! + ! Named wall-clock timers for SFINCS. + ! + ! Lightweight replacement for the scattered tloop*/tstart_*/tend_* + ! bookkeeping that used to live in each module. Timers are registered + ! lazily: the first timer_start('name') with a new name creates it; + ! subsequent calls find the existing record and accumulate. + ! + ! All timing is done via omp_get_wtime(), which returns real(8) wall + ! seconds and is guaranteed monotonic by OpenMP. This avoids two + ! pitfalls of system_clock: 32-bit count overflow on nanosecond clocks + ! (rolls over every ~2.15 s) and, under nvfortran + OpenACC GPU + ! offload, system_clock can return CPU time rather than wall time. + ! + ! Thread safety: timer_start / timer_stop are intended to be called + ! from the serial driver, outside of !$omp parallel regions. They are + ! NOT thread-safe. + ! + ! This module is a pure data module and deliberately has NO dependency + ! on sfincs_log: rendering/pretty-printing of timer data lives in + ! sfincs_log (write_timer_headers_log, write_timer_summary_log, + ! write_runtimes_file), which walks the timer list via the iteration + ! API below. Keeping the two modules separated avoids a circular + ! dependency (sfincs_log already uses timer_elapsed internally). + ! + ! Subroutines / functions: + ! + ! timer_start(name) / timer_stop(name) + ! Start / stop a named timer. Lazily registers on first start. + ! Called from every phase in sfincs_lib (Input, Simulation loop, + ! Boundaries, Momentum, Continuity, Output, ...) and from + ! update_wave_field in sfincs_snapwave. + ! + ! timer_reset(name) + ! Zero a single timer. Currently unused by the main driver but + ! kept as part of the public API. + ! + ! timer_elapsed(name) / timer_count(name) + ! Read accumulated wall time / call count for a named timer. + ! Called from sfincs_log (write_progress_log, + ! write_finished_log, write_timer_headers_log, + ! write_runtimes_file). + ! + ! timer_total_wall() + ! Sum of accumulated wall time across all registered timers. + ! Called from write_timer_summary_log in sfincs_log. + ! + ! timer_num_registered() + ! Number of timers currently registered. Called from + ! write_timer_summary_log in sfincs_log. + ! + ! timer_name_by_index(i) / timer_elapsed_by_index(i) / + ! timer_count_by_index(i) + ! Iteration API: read a timer's stored name / accumulated wall + ! time / call count by index. Indices run 1 .. timer_num_registered(). + ! Called from write_timer_summary_log in sfincs_log. + ! + use omp_lib + ! + implicit none + ! + private + ! + public :: timer_start + public :: timer_stop + public :: timer_reset + public :: timer_elapsed + public :: timer_count + public :: timer_total_wall + public :: timer_num_registered + public :: timer_name_by_index + public :: timer_elapsed_by_index + public :: timer_count_by_index + ! + integer, parameter :: name_len = 32 + integer, parameter :: max_timers = 64 + ! + type :: timer_record + character(len=name_len) :: name = '' + real(8) :: accumulated = 0.0_8 + real(8) :: last_start = 0.0_8 + integer :: n_calls = 0 + logical :: running = .false. + logical :: warned_start = .false. + logical :: warned_stop = .false. + end type timer_record + ! + type(timer_record), save :: timers(max_timers) + integer, save :: n_timers = 0 + logical, save :: warned_full = .false. + ! +contains + ! + !-----------------------------------------------------------------------------------------------------! + ! + integer function timer_find(name) result(idx) + ! + ! Return the index of the timer with the given name, or 0 if not present. + ! + ! Called from: timer_find_or_register, timer_stop, timer_reset, + ! timer_elapsed, timer_count (all within this module). + ! + character(len=*), intent(in) :: name + integer :: i + ! + idx = 0 + ! + do i = 1, n_timers + ! + if (trim(timers(i)%name) == trim(name)) then + idx = i + return + endif + ! + enddo + ! + end function timer_find + ! + !-----------------------------------------------------------------------------------------------------! + ! + integer function timer_find_or_register(name) result(idx) + ! + ! Return the index of the timer with the given name, creating a new + ! record if it did not yet exist. Returns 0 if the table is full. + ! + ! Called from: timer_start (within this module). + ! + character(len=*), intent(in) :: name + ! + idx = timer_find(name) + ! + if (idx > 0) return + ! + if (n_timers >= max_timers) then + ! + if (.not. warned_full) then + ! + write(*, '(a)') ' Warning: sfincs_timers table full, timer ignored: '//trim(name) + warned_full = .true. + ! + endif + ! + idx = 0 + return + ! + endif + ! + n_timers = n_timers + 1 + idx = n_timers + ! + timers(idx)%name = name + timers(idx)%accumulated = 0.0_8 + timers(idx)%last_start = 0.0_8 + timers(idx)%n_calls = 0 + timers(idx)%running = .false. + timers(idx)%warned_start = .false. + timers(idx)%warned_stop = .false. + ! + end function timer_find_or_register + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine timer_start(name) + ! + ! Start (or resume-and-accumulate-on-stop) the timer with the given name. + ! Lazily registers a new timer on first call. + ! + ! Called from: sfincs_lib (main driver, every phase) and + ! update_wave_field in sfincs_snapwave. + ! + character(len=*), intent(in) :: name + integer :: idx + ! + idx = timer_find_or_register(name) + ! + if (idx == 0) return + ! + if (timers(idx)%running) then + ! + if (.not. timers(idx)%warned_start) then + ! + write(*, '(a)') ' Warning: timer_start on already-running timer: '//trim(name) + timers(idx)%warned_start = .true. + ! + endif + ! + return + ! + endif + ! + timers(idx)%last_start = omp_get_wtime() + timers(idx)%running = .true. + ! + end subroutine timer_start + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine timer_stop(name) + ! + ! Stop the timer and add the elapsed interval to its accumulated total. + ! + ! Called from: sfincs_lib (main driver, every phase) and + ! update_wave_field in sfincs_snapwave. + ! + character(len=*), intent(in) :: name + integer :: idx + ! + idx = timer_find(name) + ! + if (idx == 0) then + ! + write(*, '(a)') ' Warning: timer_stop on unknown timer: '//trim(name) + return + ! + endif + ! + if (.not. timers(idx)%running) then + ! + if (.not. timers(idx)%warned_stop) then + ! + write(*, '(a)') ' Warning: timer_stop on non-running timer: '//trim(name) + timers(idx)%warned_stop = .true. + ! + endif + ! + return + ! + endif + ! + timers(idx)%accumulated = timers(idx)%accumulated + (omp_get_wtime() - timers(idx)%last_start) + timers(idx)%n_calls = timers(idx)%n_calls + 1 + timers(idx)%running = .false. + ! + end subroutine timer_stop + ! + !-----------------------------------------------------------------------------------------------------! + ! + subroutine timer_reset(name) + ! + ! Reset a single timer's accumulated time and call count to zero. + ! + ! Called from: (currently no live callers; part of the public API.) + ! + character(len=*), intent(in) :: name + integer :: idx + ! + idx = timer_find(name) + ! + if (idx == 0) return + ! + timers(idx)%accumulated = 0.0_8 + timers(idx)%n_calls = 0 + timers(idx)%running = .false. + ! + end subroutine timer_reset + ! + !-----------------------------------------------------------------------------------------------------! + ! + real(8) function timer_elapsed(name) result(elapsed) + ! + ! Accumulated wall time (in seconds) for the named timer. + ! Returns 0 if the timer is unknown. If the timer is currently running, + ! the interval since the most recent timer_start is included (without + ! modifying the stored accumulated value). + ! + ! Called from: sfincs_log (write_progress_log, write_finished_log, + ! write_timer_headers_log, write_runtimes_file). + ! + character(len=*), intent(in) :: name + integer :: idx + ! + idx = timer_find(name) + ! + if (idx == 0) then + elapsed = 0.0_8 + return + endif + ! + elapsed = timers(idx)%accumulated + ! + if (timers(idx)%running) then + ! + elapsed = elapsed + (omp_get_wtime() - timers(idx)%last_start) + ! + endif + ! + end function timer_elapsed + ! + !-----------------------------------------------------------------------------------------------------! + ! + integer function timer_count(name) result(n) + ! + ! Number of completed start/stop cycles for the named timer. + ! + ! Called from: (currently no live callers; part of the public API.) + ! + character(len=*), intent(in) :: name + integer :: idx + ! + idx = timer_find(name) + ! + if (idx == 0) then + n = 0 + return + endif + ! + n = timers(idx)%n_calls + ! + end function timer_count + ! + !-----------------------------------------------------------------------------------------------------! + ! + real(8) function timer_total_wall() result(total) + ! + ! Sum of accumulated wall time across all registered timers. + ! + ! Called from: write_timer_summary_log in sfincs_log. + ! + integer :: i + ! + total = 0.0_8 + ! + do i = 1, n_timers + total = total + timers(i)%accumulated + enddo + ! + end function timer_total_wall + ! + !-----------------------------------------------------------------------------------------------------! + ! + integer function timer_num_registered() result(n) + ! + ! Number of timers currently registered. Used by the rendering + ! routines in sfincs_log to iterate over every timer without + ! touching module-private state. + ! + ! Called from: write_timer_summary_log in sfincs_log. + ! + n = n_timers + ! + end function timer_num_registered + ! + !-----------------------------------------------------------------------------------------------------! + ! + function timer_name_by_index(i) result(name) + ! + ! Return the stored name of the i-th registered timer, or an empty + ! string for out-of-range i. Indices run 1 .. timer_num_registered(). + ! + ! Called from: write_timer_summary_log in sfincs_log. + ! + integer, intent(in) :: i + character(len=name_len) :: name + ! + if (i < 1 .or. i > n_timers) then + name = '' + return + endif + ! + name = timers(i)%name + ! + end function timer_name_by_index + ! + !-----------------------------------------------------------------------------------------------------! + ! + real(8) function timer_elapsed_by_index(i) result(elapsed) + ! + ! Accumulated wall time of the i-th registered timer. Returns 0 for + ! out-of-range i. Does NOT include a running-interval contribution + ! (use timer_elapsed(name) if you need that — the rendering code + ! runs after the simulation loop has stopped all timers). + ! + ! Called from: write_timer_summary_log in sfincs_log. + ! + integer, intent(in) :: i + ! + if (i < 1 .or. i > n_timers) then + elapsed = 0.0_8 + return + endif + ! + elapsed = timers(i)%accumulated + ! + end function timer_elapsed_by_index + ! + !-----------------------------------------------------------------------------------------------------! + ! + integer function timer_count_by_index(i) result(n) + ! + ! Number of completed start/stop cycles of the i-th registered + ! timer. Returns 0 for out-of-range i. + ! + ! Called from: write_timer_summary_log in sfincs_log. + ! + integer, intent(in) :: i + ! + if (i < 1 .or. i > n_timers) then + n = 0 + return + endif + ! + n = timers(i)%n_calls + ! + end function timer_count_by_index + ! +end module sfincs_timers diff --git a/source/src/sfincs_wavemaker.f90 b/source/src/sfincs_wavemaker.f90 index 278aed33e..74ac8c4fc 100644 --- a/source/src/sfincs_wavemaker.f90 +++ b/source/src/sfincs_wavemaker.f90 @@ -1397,12 +1397,13 @@ subroutine initialize_wavemakers() end subroutine - subroutine update_wavemaker_fluxes(t, dt, tloop) + subroutine update_wavemaker_fluxes(t, dt) ! ! Update fluxes qx and qy at wave maker points ! use sfincs_data use sfincs_snapwave + use sfincs_timers ! implicit none ! @@ -1414,13 +1415,7 @@ subroutine update_wavemaker_fluxes(t, dt, tloop) real*4 :: wave_steepness, betas, zinc, zig, dwvm, ztot, hm0_inc real*4 :: ui, ub, dzuv, facint, zsuv, depthuv, uvm0 ! - integer :: count0 - integer :: count1 - integer :: count_rate - integer :: count_max - real :: tloop - ! - call system_clock(count0, count_rate, count_max) + call timer_start('wavemaker') ! ! Factors for double-exponential filtering ! @@ -1755,9 +1750,8 @@ subroutine update_wavemaker_fluxes(t, dt, tloop) enddo !$acc end parallel ! - call system_clock(count1, count_rate, count_max) - tloop = tloop + 1.0*(count1 - count0)/count_rate + call timer_stop('wavemaker') ! end subroutine - + end module diff --git a/source/src/snapwave/snapwave_solver.f90 b/source/src/snapwave/snapwave_solver.f90 index f6c07b41f..df08c5e2b 100644 --- a/source/src/snapwave/snapwave_solver.f90 +++ b/source/src/snapwave/snapwave_solver.f90 @@ -1638,9 +1638,9 @@ end subroutine hpsort_eps_epw subroutine timer(t) real*4,intent(out) :: t - integer*4 :: count,count_rate,count_max + integer*8 :: count,count_rate,count_max call system_clock (count,count_rate, count_max) - t = real(count) / count_rate + t = real(dble(count) / dble(count_rate), 4) end subroutine timer subroutine vegatt(sigm, no_nodes, kwav, no_secveg, veg_ah, veg_bstems, veg_Nstems, veg_Cd, depth, rho, g, H, Dveg) diff --git a/source/third_party_open/netcdf/netcdf-fortran-4.6.1/netcdff_c.vcxproj b/source/third_party_open/netcdf/netcdf-fortran-4.6.1/netcdff_c.vcxproj index bb14a4db0..e79c9c068 100644 --- a/source/third_party_open/netcdf/netcdf-fortran-4.6.1/netcdff_c.vcxproj +++ b/source/third_party_open/netcdf/netcdf-fortran-4.6.1/netcdff_c.vcxproj @@ -25,12 +25,12 @@ StaticLibrary MultiByte - v143 + v145 StaticLibrary MultiByte - v143 + v145