From 807ae8d323a676664d93b4f6c56d3e04b01a598a Mon Sep 17 00:00:00 2001 From: Nic Hannah Date: Wed, 15 Sep 2021 10:36:10 +1000 Subject: [PATCH] Add timers to libforcing. https://github.com/COSIMA/access-om2/issues/242 --- atm/src/atm.F90 | 20 +++ libforcing/src/forcing_field.F90 | 43 +++++- libforcing/src/util.F90 | 233 ------------------------------- libutil/src/util.F90 | 85 ++++++++--- tests/ERA5/accessom2.nml | 2 +- 5 files changed, 129 insertions(+), 254 deletions(-) delete mode 100644 libforcing/src/util.F90 diff --git a/atm/src/atm.F90 b/atm/src/atm.F90 index 15dde85..b68208f 100644 --- a/atm/src/atm.F90 +++ b/atm/src/atm.F90 @@ -38,6 +38,8 @@ program atm type(simple_timer_type) :: coupler_put_timer type(simple_timer_type) :: init_oasis_timer, init_model_timer type(simple_timer_type) :: parse_forcing_fields_timer + type(simple_timer_type) :: main_loop_timer + type(simple_timer_type) :: extras_timer namelist /atm_nml/ forcing_file, accessom2_config_dir @@ -73,6 +75,10 @@ program atm accessom2%simple_timers_enabled()) call parse_forcing_fields_timer%init('parse_forcing_fields', accessom2%logger, & accessom2%simple_timers_enabled()) + call main_loop_timer%init('main_loop_timer', accessom2%logger, & + accessom2%simple_timers_enabled()) + call extras_timer%init('extras_timer', accessom2%logger, & + accessom2%simple_timers_enabled()) call init_model_timer%start() ! Initialise forcing object, this reads config and @@ -158,9 +164,12 @@ program atm do while (.not. accessom2%run_finished()) + call extras_timer%start() cur_runtime_in_seconds = int(accessom2%get_cur_runtime_in_seconds()) + call extras_timer%stop() ! Send each forcing field + call main_loop_timer%start() do i=1, num_atm_to_ice_fields ri = to_runoff_map(i) @@ -189,6 +198,9 @@ program atm endif call coupler_put_timer%stop() enddo + call main_loop_timer%stop() + + call extras_timer%start() ! Block until we receive from ice. Ice will do a nonblocking send immediately ! after receiving the above fields. This prevents the atm from sending continuously. @@ -204,6 +216,8 @@ program atm !call accessom2%logger%write(LOG_INFO, '{ "modeltime_over_walltime_hour_per_hour" : "" ', call accessom2%progress_date(dt) + + call extras_timer%stop() enddo call field_read_timer%write_stats() @@ -214,9 +228,15 @@ program atm call init_oasis_timer%write_stats() call init_model_timer%write_stats() call parse_forcing_fields_timer%write_stats() + call main_loop_timer%write_stats() + call extras_timer%write_stats() call accessom2%logger%write(LOG_INFO, 'Run complete, calling deinit') + do i=1, num_atm_to_ice_fields + call forcing_fields(i)%deinit() + enddo + call coupler%deinit() call accessom2%deinit(finalize=.true.) call forcing_config%deinit() diff --git a/libforcing/src/forcing_field.F90 b/libforcing/src/forcing_field.F90 index 9b02ae6..3357357 100644 --- a/libforcing/src/forcing_field.F90 +++ b/libforcing/src/forcing_field.F90 @@ -9,6 +9,7 @@ module forcing_field_mod FORCING_PERTURBATION_TYPE_SEPARABLE use ncvar_mod, only : ncvar_type => ncvar use util_mod, only : filename_for_date +use simple_timer_mod, only : simple_timer_type => simple_timer implicit none private @@ -35,6 +36,11 @@ module forcing_field_mod separated_perturbations type(logger_type), pointer :: logger + + type(simple_timer_type) :: get_time_index_timer + type(simple_timer_type) :: apply_perturbations_timer + type(simple_timer_type) :: calculate_field_timer + contains procedure, pass(self), public :: init => forcing_field_init procedure, pass(self), public :: update => forcing_field_update @@ -42,12 +48,14 @@ module forcing_field_mod procedure, pass(self), private :: apply_perturbations => & forcing_field_apply_perturbations procedure, pass(self), public :: get_shape + procedure, pass(self), public :: deinit => forcing_field_deinit endtype forcing_field contains -subroutine forcing_field_init(self, name_list, filename_template_list, cname, realm, & - start_date, product_name, loggerin, dt, calendar) +subroutine forcing_field_init(self, name_list, filename_template_list, cname, & + realm, start_date, product_name, loggerin, & + dt, calendar) class(forcing_field), intent(inout) :: self character(len=*), dimension(:), intent(in) :: name_list character(len=*), dimension(:), intent(in) :: filename_template_list @@ -62,6 +70,14 @@ subroutine forcing_field_init(self, name_list, filename_template_list, cname, re character(len=1024) :: filename integer :: num_file_inputs, i + self%logger => loggerin + call self%get_time_index_timer%init('get_time_index_timer', & + loggerin, .true.) + call self%apply_perturbations_timer%init('apply_perturbations_timer', & + loggerin,.true.) + call self%calculate_field_timer%init('calculate_field_timer', & + loggerin,.true.) + num_file_inputs = size(name_list) allocate(self%names(num_file_inputs)) @@ -80,7 +96,6 @@ subroutine forcing_field_init(self, name_list, filename_template_list, cname, re endif self%product_name = trim(product_name) - self%logger => loggerin do i=1, num_file_inputs filename = filename_for_date(self%filename_templates(i), & @@ -122,6 +137,8 @@ subroutine forcing_field_update(self, forcing_date, experiment_date) integer :: indx, test_indx integer :: num_file_inputs, i + call self%get_time_index_timer%start() + num_file_inputs = size(self%ncvars) do i=1, num_file_inputs @@ -160,8 +177,12 @@ subroutine forcing_field_update(self, forcing_date, experiment_date) enddo endif + call self%get_time_index_timer%stop() + call self%calculate(indx, self%data_array) + call self%apply_perturbations_timer%start() call self%apply_perturbations(forcing_date, experiment_date) + call self%apply_perturbations_timer%stop() end subroutine forcing_field_update @@ -194,8 +215,10 @@ subroutine forcing_field_calculate(self, file_index, result_array) ! Rain is calculated as mcpr ! (mean convective precipitation rate [kg m**-2 s**-1]) plus ! mlspr (mean large-scale precipitation rate [kg m**-2 s**-1]) + call self%calculate_field_timer%start() call self%ncvars(1)%read_data(file_index, tmp1) call self%ncvars(2)%read_data(file_index, tmp2) + call self%calculate_field_timer%stop() result_array(:, :) = tmp1(:, :) + tmp2(:, :) elseif (trim(self%coupling_name) == 'qair_ai') then @@ -206,8 +229,10 @@ subroutine forcing_field_calculate(self, file_index, result_array) call assert(self%ncvars(2)%name == 'sp', & 'Unexpected name for surface pressure') + call self%calculate_field_timer%start() call self%ncvars(1)%read_data(file_index, tmp1) call self%ncvars(2)%read_data(file_index, tmp2) + call self%calculate_field_timer%stop() Td => tmp1 sp => tmp2 @@ -219,7 +244,9 @@ subroutine forcing_field_calculate(self, file_index, result_array) result_array(:, :) = (RDRY/RVAP)*E / (sp-((1-RDRY/RVAP)*E)) deallocate(E) else + call self%calculate_field_timer%start() call self%ncvars(1)%read_data(file_index, result_array) + call self%calculate_field_timer%stop() endif deallocate(tmp1, tmp2) @@ -350,6 +377,15 @@ subroutine forcing_field_apply_perturbations(self, forcing_date, experiment_date endsubroutine forcing_field_apply_perturbations +subroutine forcing_field_deinit(self) + class(forcing_field), intent(inout) :: self + + call self%get_time_index_timer%write_stats() + call self%apply_perturbations_timer%write_stats() + call self%calculate_field_timer%write_stats() + +endsubroutine forcing_field_deinit + function get_shape(self) class(forcing_field), intent(in) :: self integer, dimension(2) :: get_shape @@ -357,4 +393,5 @@ function get_shape(self) get_shape = shape(self%data_array) endfunction + endmodule forcing_field_mod diff --git a/libforcing/src/util.F90 b/libforcing/src/util.F90 deleted file mode 100644 index 4349240..0000000 --- a/libforcing/src/util.F90 +++ /dev/null @@ -1,233 +0,0 @@ -module util_mod - -use netcdf -use datetime_module, only : datetime -use error_handler, only : assert -use, intrinsic :: iso_fortran_env, only : stderr=>error_unit - -implicit none - -integer, dimension(12), parameter, private :: DAYS_IN_MONTH = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) - -contains - -subroutine ncheck(status, error_str) - - integer, intent(in) :: status - character(len=*), intent(in) :: error_str - - if (status /= nf90_noerr) then - write(stderr, '(/a)') 'Error - from NetCDF library' - write(stderr, '(a)') error_str - write(stderr, '(a/)') trim(nf90_strerror(status)) - stop - end if - -end subroutine ncheck - -!> Replace all occurrences of 'pattern' with 'replace' in string. -! Based on: http://fortranwiki.org/fortran/show/String_Functions -! BUG: endless loop if replace contains pattern -function replace_text(string, pattern, replace) result(outs) - - character(len=*), intent(in) :: string, pattern, replace - character(len(string)+100) :: outs ! provide 100 extra char - BUG: may be too few in some cases - integer :: i, nt, nr - - outs = string ; nt = len_trim(pattern) ; nr = len_trim(replace) - do - i = index(outs,pattern(:nt)) ; if (i == 0) exit - outs = outs(:i-1) // replace(:nr) // outs(i+nt:) - end do - -end function replace_text - - -subroutine read_data(ncid, varid, varname, indx, dataout) - - integer, intent(in) :: ncid, varid, indx - character(len=*), intent(in) :: varname - real, dimension(:, :), intent(out) :: dataout - - integer, dimension(:), allocatable :: count, start - real, dimension(1) :: scalar_dataout - integer :: ndims, nx, ny, time, status - real :: scale_factor, offset - - call get_var_dims(ncid, varid, ndims, nx, ny, time) - call assert(ndims == 1 .or. ndims == 2 .or. ndims == 3 .or. ndims == 4, & - 'Unsupported number of dims') - - allocate(count(ndims), start(ndims)) - nx = size(dataout, 1) - ny = size(dataout, 2) - - ! Get data, we select a specfic time-point of data to read - if (ndims == 1) then - start = (/ indx /) - count = (/ 1 /) - - call ncheck(nf90_get_var(ncid, varid, scalar_dataout, start=start, & - count=count), & - 'Get var '//trim(varname)) - dataout(:, :) = scalar_dataout(1) - else - if (ndims == 2) then - start = (/ 1, 1 /) - count = (/ nx, ny /) - elseif (ndims == 3) then - start = (/ 1, 1, indx /) - count = (/ nx, ny, 1 /) - else - start = (/ 1, 1, 1, indx /) - count = (/ nx, ny, 1, 1 /) - end if - call ncheck(nf90_get_var(ncid, varid, dataout, start=start, count=count), & - 'Get var '//trim(varname)) - endif - - status = nf90_get_att(ncid, varid, "scale_factor", scale_factor) - if (status == nf90_noerr) then - dataout(:, :) = dataout(:, :) * scale_factor - endif - status = nf90_get_att(ncid, varid, "add_offset", offset) - if (status == nf90_noerr) then - dataout(:, :) = dataout(:, :) + offset - endif - - deallocate(count, start) - -end subroutine read_data - -!> Try a number of different names to get the 'time' varid and dimid. -subroutine get_time_varid_and_dimid(ncid, dimid, varid, found) - integer, intent(in) :: ncid - integer, intent(out) :: dimid, varid - logical, intent(out) :: found - - integer :: i, status - character(len=4), dimension(4) :: names - - names(1) = 'time' - names(2) = 'TIME' - names(3) = 'AT' - names(4) = 'Time' - - do i=1, 4 - status = nf90_inq_dimid(ncid, trim(names(i)), dimid) - if (status == nf90_noerr) then - exit - endif - enddo - - if (status == nf90_noerr) then - status = nf90_inq_varid(ncid, trim(names(i)), varid) - if (status == nf90_noerr) then - found = .true. - else - found = .false. - endif - else - found = .false. - endif - -end subroutine get_time_varid_and_dimid - -! Return the spatial and time dimensions of a field. -subroutine get_var_dims(ncid, varid, ndims, nx, ny, time) - integer, intent(in) :: ncid, varid - - integer, intent(out) :: ndims, nx, ny, time - - integer, dimension(:), allocatable :: dimids - integer :: i, len - character(len=nf90_max_name) :: dimname - - ! Get dimensions used by this var. - call ncheck(nf90_inquire_variable(ncid, varid, ndims=ndims), & - 'get_var_dims: Inquire ndims') - allocate(dimids(ndims)) - call ncheck(nf90_inquire_variable(ncid, varid, dimids=dimids), & - 'get_var_dims: Inquire dimids') - - ! Only support dimension names: time, latitude, longitude for now. - nx = 0 - ny = 0 - time = 0 - do i=1, ndims - call ncheck(nf90_inquire_dimension(ncid, dimids(i), & - name=dimname, len=len), & - 'get_var_dims: Inquire dimension '//dimname) - if (trim(dimname) == 'time' .or. trim(dimname) == 'AT' .or. & - trim(dimname) == 'TIME' .or. trim(dimname) == 'Time') then - time = len - elseif (trim(dimname) == 'latitude' .or. trim(dimname) == 'AY' .or. & - trim(dimname) == 'ny' .or. trim(dimname) == 'LAT' .or. & - trim(dimname) == 'lat' .or. trim(dimname) == 'nj') then - ny = len - elseif (trim(dimname) == 'longitude' .or. trim(dimname) == 'AX' .or. & - trim(dimname) == 'nx' .or. trim(dimname) == 'LON' .or. & - trim(dimname) == 'lon' .or. trim(dimname) == 'ni') then - nx = len - else - call assert(.false., 'get_var_dims: Unsupported dimension name '//trim(dimname)) - endif - enddo - - deallocate(dimids) - -endsubroutine get_var_dims - -!> Search for a filename that contains year, month, start_day and end_day -! substrings. This is very specifically designed to handle the kinds -! of filenames used for JRA55 and ERA5 atmospheric forcings. - -function filename_for_date(filename_template, date) - character(len=*), intent(in) :: filename_template - type(datetime), intent(in) :: date - - integer :: year, month, start_day, end_day - character(len=1024) :: filename_for_date - character(len=4) :: year_str, yearp1_str - character(len=2) :: month_str, start_day_str, end_day_str - - year = date%getYear() - month = date%getMonth() - - write(year_str, "(I4.4)") year - write(yearp1_str, "(I4.4)") year+1 - write(month_str, "(I2.2)") month - - start_day = 1 - end_day = DAYS_IN_MONTH(month) - write(start_day_str, "(I2.2)") start_day - write(end_day_str, "(I2.2)") end_day - - filename_for_date = replace_text(filename_template, & - "{{ year }}", year_str) - filename_for_date = replace_text(filename_for_date, & - "{{year}}", year_str) - filename_for_date = replace_text(filename_for_date, & - "{{ year+1 }}", yearp1_str) - filename_for_date = replace_text(filename_for_date, & - "{{year+1}}", yearp1_str) - - filename_for_date = replace_text(filename_for_date, & - "{{ month }}", month_str) - filename_for_date = replace_text(filename_for_date, & - "{{month}}", month_str) - - filename_for_date = replace_text(filename_for_date, & - "{{ start_day }}", start_day_str) - filename_for_date = replace_text(filename_for_date, & - "{{start_day}}", start_day_str) - - filename_for_date = replace_text(filename_for_date, & - "{{ end_day }}", end_day_str) - filename_for_date = replace_text(filename_for_date, & - "{{end_day}}", end_day_str) - -endfunction filename_for_date - - -end module util_mod diff --git a/libutil/src/util.F90 b/libutil/src/util.F90 index 1066a59..4349240 100644 --- a/libutil/src/util.F90 +++ b/libutil/src/util.F90 @@ -1,11 +1,14 @@ module util_mod use netcdf +use datetime_module, only : datetime use error_handler, only : assert use, intrinsic :: iso_fortran_env, only : stderr=>error_unit implicit none +integer, dimension(12), parameter, private :: DAYS_IN_MONTH = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /) + contains subroutine ncheck(status, error_str) @@ -48,7 +51,8 @@ subroutine read_data(ncid, varid, varname, indx, dataout) integer, dimension(:), allocatable :: count, start real, dimension(1) :: scalar_dataout - integer :: ndims, nx, ny, time + integer :: ndims, nx, ny, time, status + real :: scale_factor, offset call get_var_dims(ncid, varid, ndims, nx, ny, time) call assert(ndims == 1 .or. ndims == 2 .or. ndims == 3 .or. ndims == 4, & @@ -82,6 +86,15 @@ subroutine read_data(ncid, varid, varname, indx, dataout) 'Get var '//trim(varname)) endif + status = nf90_get_att(ncid, varid, "scale_factor", scale_factor) + if (status == nf90_noerr) then + dataout(:, :) = dataout(:, :) * scale_factor + endif + status = nf90_get_att(ncid, varid, "add_offset", offset) + if (status == nf90_noerr) then + dataout(:, :) = dataout(:, :) + offset + endif + deallocate(count, start) end subroutine read_data @@ -108,9 +121,12 @@ subroutine get_time_varid_and_dimid(ncid, dimid, varid, found) enddo if (status == nf90_noerr) then - found = .true. - call ncheck(nf90_inq_varid(ncid, trim(names(i)), varid), & - "get_time_varid_and_dimid: Can't find time var") + status = nf90_inq_varid(ncid, trim(names(i)), varid) + if (status == nf90_noerr) then + found = .true. + else + found = .false. + endif else found = .false. endif @@ -162,21 +178,56 @@ subroutine get_var_dims(ncid, varid, ndims, nx, ny, time) endsubroutine get_var_dims +!> Search for a filename that contains year, month, start_day and end_day +! substrings. This is very specifically designed to handle the kinds +! of filenames used for JRA55 and ERA5 atmospheric forcings. -function filename_for_year(filename, year) - character(len=*), intent(in) :: filename - integer, intent(in) :: year - character(len=1024) :: filename_for_year - character(len=4) :: year_str, yearp1_str - - write(year_str, "(I4)") year - write(yearp1_str, "(I4)") year+1 +function filename_for_date(filename_template, date) + character(len=*), intent(in) :: filename_template + type(datetime), intent(in) :: date - filename_for_year = replace_text(filename, "{{ year }}", year_str) - filename_for_year = replace_text(filename_for_year, "{{year}}", year_str) - filename_for_year = replace_text(filename_for_year, "{{ year+1 }}", yearp1_str) - filename_for_year = replace_text(filename_for_year, "{{year+1}}", yearp1_str) -endfunction filename_for_year + integer :: year, month, start_day, end_day + character(len=1024) :: filename_for_date + character(len=4) :: year_str, yearp1_str + character(len=2) :: month_str, start_day_str, end_day_str + + year = date%getYear() + month = date%getMonth() + + write(year_str, "(I4.4)") year + write(yearp1_str, "(I4.4)") year+1 + write(month_str, "(I2.2)") month + + start_day = 1 + end_day = DAYS_IN_MONTH(month) + write(start_day_str, "(I2.2)") start_day + write(end_day_str, "(I2.2)") end_day + + filename_for_date = replace_text(filename_template, & + "{{ year }}", year_str) + filename_for_date = replace_text(filename_for_date, & + "{{year}}", year_str) + filename_for_date = replace_text(filename_for_date, & + "{{ year+1 }}", yearp1_str) + filename_for_date = replace_text(filename_for_date, & + "{{year+1}}", yearp1_str) + + filename_for_date = replace_text(filename_for_date, & + "{{ month }}", month_str) + filename_for_date = replace_text(filename_for_date, & + "{{month}}", month_str) + + filename_for_date = replace_text(filename_for_date, & + "{{ start_day }}", start_day_str) + filename_for_date = replace_text(filename_for_date, & + "{{start_day}}", start_day_str) + + filename_for_date = replace_text(filename_for_date, & + "{{ end_day }}", end_day_str) + filename_for_date = replace_text(filename_for_date, & + "{{end_day}}", end_day_str) + +endfunction filename_for_date end module util_mod diff --git a/tests/ERA5/accessom2.nml b/tests/ERA5/accessom2.nml index cfe9771..e89702f 100644 --- a/tests/ERA5/accessom2.nml +++ b/tests/ERA5/accessom2.nml @@ -7,5 +7,5 @@ &date_manager_nml forcing_start_date = '1981-01-01T00:00:00' forcing_end_date = '1981-02-01T00:00:00' - restart_period = 0, 1, 0 + restart_period = 0, 0, 86400 /