From 1a7fc7faa0b96152d79c48bc334aff2e1b5b292d Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Thu, 31 Oct 2024 10:20:46 -0400 Subject: [PATCH 1/6] chore: removed unused routine from normal_distribution_mod.f90 fixes #736 --- .../assimilation/normal_distribution_mod.f90 | 45 ------------------- 1 file changed, 45 deletions(-) diff --git a/assimilation_code/modules/assimilation/normal_distribution_mod.f90 b/assimilation_code/modules/assimilation/normal_distribution_mod.f90 index 6b0656c62d..b3a7c33290 100644 --- a/assimilation_code/modules/assimilation/normal_distribution_mod.f90 +++ b/assimilation_code/modules/assimilation/normal_distribution_mod.f90 @@ -493,51 +493,6 @@ subroutine set_normal_params_from_ens(ens, num, p) end subroutine set_normal_params_from_ens -!------------------------------------------------------------------------ -subroutine inv_cdf_quadrature_like(quantiles, ens, likelihood, ens_size, cdf, p, x_out) - -interface - function cdf(x, p) - use types_mod, only : r8 - use distribution_params_mod, only : distribution_params_type - real(r8) :: cdf - real(r8), intent(in) :: x - type(distribution_params_type), intent(in) :: p - end function -end interface - -integer, intent(in) :: ens_size -real(r8), intent(in) :: quantiles(ens_size) -real(r8), intent(in) :: ens(ens_size) -real(r8), intent(in) :: likelihood(ens_size) -type(distribution_params_type), intent(in) :: p -real(r8), intent(out) :: x_out(ens_size) - -integer :: i -real(r8) :: quad_like(ens_size + 1), q_ens(ens_size + 1) - -! Assume that the quantiles and the corresponding ens are sorted - -! Get the likelihood for each of the ens_size + 1 intervals -do i = 2, ens_size - quad_like(i) = (likelihood(i - 1) + likelihood(i)) / 2.0_r8 -end do -quad_like(1) = likelihood(1) -quad_like(ens_size + 1) = likelihood(ens_size) - -! Compute the quantiles at the ensemble boundaries for the posterior -q_ens(1) = quad_like(1) * quantiles(1) -do i = 2, ens_size - q_ens(i) = q_ens(i - 1) + quad_like(i) * (quantiles(i) - quantiles(i - 1)) -end do -q_ens(ens_size + 1) = q_ens(ens_size) + & - quad_like(ens_size + 1) * (1.0_r8 - quantiles(ens_size)) - -! Normalize so that this is a posterior cdf -q_ens = q_ens / q_ens(ens_size + 1) - -end subroutine inv_cdf_quadrature_like - !------------------------------------------------------------------------ end module normal_distribution_mod From a83943e71c9de63cb50b4b1b86e0d0ecb93ec931 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 5 Nov 2024 15:39:34 -0700 Subject: [PATCH 2/6] Removing an unneeded subroutine broadcast_minmax from the mpi_utilies files (mpi_utilities_mod.f90, mpif08_utilities_mod.f90, null_mpi_utilities_mod.f90); reverting to the original name all_reduce_min_max as this is accurate to the content of the subroutine --- .../modules/utilities/mpi_utilities_mod.f90 | 29 +++---------------- .../utilities/mpif08_utilities_mod.f90 | 29 +++---------------- .../utilities/null_mpi_utilities_mod.f90 | 24 +++------------ 3 files changed, 12 insertions(+), 70 deletions(-) diff --git a/assimilation_code/modules/utilities/mpi_utilities_mod.f90 b/assimilation_code/modules/utilities/mpi_utilities_mod.f90 index 90797018e8..d9bd640a38 100644 --- a/assimilation_code/modules/utilities/mpi_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/mpi_utilities_mod.f90 @@ -12,11 +12,6 @@ !> and allows programs to swap in the null version to compile the !> same source files into a serial program. !> -!> The names of these routines were intentionally picked to be -!> more descriptive to someone who doesn't the MPI interfaces. -!> e.g. MPI_AllReduce() may not immediately tell a user what -!> it does, but broadcast_minmax() is hopefully more helpful. -!> !> If you add any routines or change any arguments in this file !> you must make the same changes in the null version. These two !> modules have the same module name and must have identical @@ -138,9 +133,8 @@ module mpi_utilities_mod task_sync, array_broadcast, send_to, receive_from, iam_task0, & broadcast_send, broadcast_recv, shell_execute, sleep_seconds, & sum_across_tasks, get_dart_mpi_comm, datasize, send_minmax_to, & - get_from_fwd, get_from_mean, broadcast_minmax, broadcast_flag, & - start_mpi_timer, read_mpi_timer, send_sum_to, get_global_max, & - all_reduce_min_max ! deprecated, replace by broadcast_minmax + get_from_fwd, get_from_mean, broadcast_flag, start_mpi_timer, & + read_mpi_timer, send_sum_to, get_global_max, all_reduce_min_max character(len=*), parameter :: source = 'mpi_utilities_mod.f90' @@ -1467,26 +1461,11 @@ end subroutine send_minmax_to !----------------------------------------------------------------------------- -!> cover routine which is deprecated. when all user code replaces this -!> with broadcast_minmax(), remove this. - -subroutine all_reduce_min_max(min_var, max_var, num_elements) - -integer, intent(in) :: num_elements -real(r8), intent(inout) :: min_var(num_elements) -real(r8), intent(inout) :: max_var(num_elements) - -call broadcast_minmax(min_var, max_var, num_elements) - -end subroutine all_reduce_min_max - -!----------------------------------------------------------------------------- - !> Find min and max of each element of an array, put the result on every task. !> Overwrites arrays min_var, max_var with the minimum and maximum for each !> element across all tasks. -subroutine broadcast_minmax(min_var, max_var, num_elements) +subroutine all_reduce_min_max(min_var, max_var, num_elements) integer, intent(in) :: num_elements real(r8), intent(inout) :: min_var(num_elements) @@ -1502,7 +1481,7 @@ subroutine broadcast_minmax(min_var, max_var, num_elements) call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode) call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, datasize, MPI_MAX, get_dart_mpi_comm(), errcode) -end subroutine broadcast_minmax +end subroutine all_reduce_min_max !----------------------------------------------------------------------------- !> Broadcast logical diff --git a/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 b/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 index dee8c618d1..51bc507fe0 100644 --- a/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 @@ -12,11 +12,6 @@ !> and allows programs to swap in the null version to compile the !> same source files into a serial program. !> -!> The names of these routines were intentionally picked to be -!> more descriptive to someone who doesn't the MPI interfaces. -!> e.g. MPI_AllReduce() may not immediately tell a user what -!> it does, but broadcast_minmax() is hopefully more helpful. -!> !> If you add any routines or change any arguments in this file !> you must make the same changes in the null version. These two !> modules have the same module name and must have identical @@ -138,9 +133,8 @@ module mpi_utilities_mod task_sync, array_broadcast, send_to, receive_from, iam_task0, & broadcast_send, broadcast_recv, shell_execute, sleep_seconds, & sum_across_tasks, get_dart_mpi_comm, datasize, send_minmax_to, & - get_from_fwd, get_from_mean, broadcast_minmax, broadcast_flag, & - start_mpi_timer, read_mpi_timer, send_sum_to, get_global_max, & - all_reduce_min_max ! deprecated, replace by broadcast_minmax + get_from_fwd, get_from_mean, broadcast_flag, start_mpi_timer, & + read_mpi_timer, send_sum_to, get_global_max, all_reduce_min_max character(len=*), parameter :: source = 'mpi_utilities_mod.f90' @@ -1467,26 +1461,11 @@ end subroutine send_minmax_to !----------------------------------------------------------------------------- -!> cover routine which is deprecated. when all user code replaces this -!> with broadcast_minmax(), remove this. - -subroutine all_reduce_min_max(min_var, max_var, num_elements) - -integer, intent(in) :: num_elements -real(r8), intent(inout) :: min_var(num_elements) -real(r8), intent(inout) :: max_var(num_elements) - -call broadcast_minmax(min_var, max_var, num_elements) - -end subroutine all_reduce_min_max - -!----------------------------------------------------------------------------- - !> Find min and max of each element of an array, put the result on every task. !> Overwrites arrays min_var, max_var with the minimum and maximum for each !> element across all tasks. -subroutine broadcast_minmax(min_var, max_var, num_elements) +subroutine all_reduce_min_max(min_var, max_var, num_elements) integer, intent(in) :: num_elements real(r8), intent(inout) :: min_var(num_elements) @@ -1502,7 +1481,7 @@ subroutine broadcast_minmax(min_var, max_var, num_elements) call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode) call mpi_allreduce(MPI_IN_PLACE, max_var, num_elements, datasize, MPI_MAX, get_dart_mpi_comm(), errcode) -end subroutine broadcast_minmax +end subroutine all_reduce_min_max !----------------------------------------------------------------------------- !> Broadcast logical diff --git a/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90 b/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90 index cc729c23aa..f2d38eb057 100644 --- a/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/null_mpi_utilities_mod.f90 @@ -109,9 +109,8 @@ module mpi_utilities_mod task_sync, array_broadcast, send_to, receive_from, iam_task0, & broadcast_send, broadcast_recv, shell_execute, sleep_seconds, & sum_across_tasks, get_dart_mpi_comm, datasize, send_minmax_to, & - get_from_fwd, get_from_mean, broadcast_minmax, broadcast_flag, & - start_mpi_timer, read_mpi_timer, send_sum_to, get_global_max, & - all_reduce_min_max ! deprecated, replace by broadcast_minmax + get_from_fwd, get_from_mean, broadcast_flag, start_mpi_timer, & + read_mpi_timer, send_sum_to, get_global_max, all_reduce_min_max character(len=*), parameter :: source = 'null_mpi_utilities_mod.f90' @@ -432,32 +431,17 @@ end subroutine send_minmax_to !----------------------------------------------------------------------------- -!> cover routine which is deprecated. when all user code replaces this -!> with broadcast_minmax(), remove this. - -subroutine all_reduce_min_max(min_var, max_var, num_elements) - -integer, intent(in) :: num_elements -real(r8), intent(inout) :: min_var(num_elements) -real(r8), intent(inout) :: max_var(num_elements) - -call broadcast_minmax(min_var, max_var, num_elements) - -end subroutine all_reduce_min_max - -!----------------------------------------------------------------------------- - !> Find min and max of each element of an array across tasks, put the result on every task. !> For this null_mpi_version min_var and max_var are unchanged because there is !> only 1 task. -subroutine broadcast_minmax(min_var, max_var, num_elements) +subroutine all_reduce_min_max(min_var, max_var, num_elements) integer, intent(in) :: num_elements real(r8), intent(inout) :: min_var(num_elements) real(r8), intent(inout) :: max_var(num_elements) -end subroutine broadcast_minmax +end subroutine all_reduce_min_max !----------------------------------------------------------------------------- From 69ff3c9ee3a946c163f0b2de58cd8c6e86104770 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 5 Nov 2024 15:43:57 -0700 Subject: [PATCH 3/6] Changing calls to broadcast_minmax to call all_reduce_min_max in FESOM and mpas_atm model_mods --- models/FESOM/model_mod.f90 | 4 ++-- models/mpas_atm/model_mod.f90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/models/FESOM/model_mod.f90 b/models/FESOM/model_mod.f90 index 3233cf1492..b6387431f6 100644 --- a/models/FESOM/model_mod.f90 +++ b/models/FESOM/model_mod.f90 @@ -60,7 +60,7 @@ module model_mod use obs_kind_mod, only : get_index_for_quantity -use mpi_utilities_mod, only: my_task_id, broadcast_minmax, task_count +use mpi_utilities_mod, only: my_task_id, all_reduce_min_max, task_count use fesom_modules, only: read_node, read_aux3, read_depth, read_namelist, & nCells => myDim_nod2D, & ! number of surface locations @@ -828,7 +828,7 @@ subroutine pert_model_copies(ens_handle, ens_size, pert_amp, interf_provided) enddo ! get global min/max for each variable -call broadcast_minmax(min_var, max_var, num_variables) +call all_reduce_min_max(min_var, max_var, num_variables) deallocate(within_range) call init_random_seq(random_seq, my_task_id()+1) diff --git a/models/mpas_atm/model_mod.f90 b/models/mpas_atm/model_mod.f90 index 29282f7a8a..839921d457 100644 --- a/models/mpas_atm/model_mod.f90 +++ b/models/mpas_atm/model_mod.f90 @@ -104,7 +104,7 @@ module model_mod QTY_SURFACE_TYPE, & ! for rttov QTY_CLOUD_FRACTION ! for rttov -use mpi_utilities_mod, only: my_task_id, broadcast_minmax +use mpi_utilities_mod, only: my_task_id, all_reduce_min_max use random_seq_mod, only: random_seq_type, init_random_seq, random_gaussian @@ -1812,7 +1812,7 @@ subroutine pert_model_copies(ens_handle, ens_size, pert_amp, interf_provided) enddo ! get global min/max for each variable -call broadcast_minmax(min_var, max_var, num_variables) +call all_reduce_min_max(min_var, max_var, num_variables) deallocate(within_range) call init_random_seq(random_seq, my_task_id()+1) From 55eaccd61fca194464f196c629465b71433bfd59 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Tue, 5 Nov 2024 16:16:28 -0700 Subject: [PATCH 4/6] Removing loops in time_manager_mod that are not needed --- .../modules/utilities/time_manager_mod.f90 | 92 ++++++++----------- 1 file changed, 37 insertions(+), 55 deletions(-) diff --git a/assimilation_code/modules/utilities/time_manager_mod.f90 b/assimilation_code/modules/utilities/time_manager_mod.f90 index db35f4fd33..c74230dff4 100644 --- a/assimilation_code/modules/utilities/time_manager_mod.f90 +++ b/assimilation_code/modules/utilities/time_manager_mod.f90 @@ -694,7 +694,6 @@ subroutine set_calendar_type_string(calstring) character(len=len(calstring)) :: str1 character(len=max_calendar_string_length) :: cstring logical :: found_calendar = .false. -integer :: i if ( .not. module_initialized ) call time_manager_init @@ -714,47 +713,34 @@ subroutine set_calendar_type_string(calstring) ! We must check for the gregorian_mars calendar before ! the gregorian calendar for similar reasons. -WhichCalendar : do i = 0, max_type - - if ( cstring == 'NO_CALENDAR' ) then - calendar_type = NO_CALENDAR - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'NO CALENDAR' ) then ! allow this as a synonym - calendar_type = NO_CALENDAR - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'NONE' ) then ! also allow this - calendar_type = NO_CALENDAR - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'THIRTY_DAY_MONTHS' ) then - calendar_type = THIRTY_DAY_MONTHS - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'JULIAN' ) then - calendar_type = JULIAN - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'NOLEAP' ) then - calendar_type = NOLEAP - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'GREGORIAN_MARS' ) then - calendar_type = GREGORIAN_MARS - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'SOLAR_MARS' ) then - calendar_type = SOLAR_MARS - found_calendar = .true. - exit WhichCalendar - elseif ( cstring == 'GREGORIAN' ) then - calendar_type = GREGORIAN - found_calendar = .true. - exit WhichCalendar - endif - -enddo WhichCalendar +if ( cstring == 'NO_CALENDAR' ) then + calendar_type = NO_CALENDAR + found_calendar = .true. +elseif ( cstring == 'NO CALENDAR' ) then ! allow this as a synonym + calendar_type = NO_CALENDAR + found_calendar = .true. +elseif ( cstring == 'NONE' ) then ! also allow this + calendar_type = NO_CALENDAR + found_calendar = .true. +elseif ( cstring == 'THIRTY_DAY_MONTHS' ) then + calendar_type = THIRTY_DAY_MONTHS + found_calendar = .true. +elseif ( cstring == 'JULIAN' ) then + calendar_type = JULIAN + found_calendar = .true. +elseif ( cstring == 'NOLEAP' ) then + calendar_type = NOLEAP + found_calendar = .true. +elseif ( cstring == 'GREGORIAN_MARS' ) then + calendar_type = GREGORIAN_MARS + found_calendar = .true. +elseif ( cstring == 'SOLAR_MARS' ) then + calendar_type = SOLAR_MARS + found_calendar = .true. +elseif ( cstring == 'GREGORIAN' ) then + calendar_type = GREGORIAN + found_calendar = .true. +endif if( .not. found_calendar ) then write(errstring,*)'Unknown calendar ',calstring @@ -785,23 +771,19 @@ subroutine get_calendar_string(mystring) ! ! Returns default calendar type for mapping from time to date. -character(len=*), intent(OUT) :: mystring - -integer :: i +character(len=*), intent(out) :: mystring if ( .not. module_initialized ) call time_manager_init -mystring = ' ' +mystring = '' -do i = 0,max_type - if (calendar_type == JULIAN) mystring = 'JULIAN' - if (calendar_type == NOLEAP) mystring = 'NOLEAP' - if (calendar_type == GREGORIAN) mystring = 'GREGORIAN' - if (calendar_type == NO_CALENDAR) mystring = 'NO_CALENDAR' - if (calendar_type == GREGORIAN_MARS) mystring = 'GREGORIAN_MARS' - if (calendar_type == SOLAR_MARS) mystring = 'SOLAR_MARS' - if (calendar_type == THIRTY_DAY_MONTHS) mystring = 'THIRTY_DAY_MONTHS' -enddo +if (calendar_type == JULIAN) mystring = 'JULIAN' +if (calendar_type == NOLEAP) mystring = 'NOLEAP' +if (calendar_type == GREGORIAN) mystring = 'GREGORIAN' +if (calendar_type == NO_CALENDAR) mystring = 'NO_CALENDAR' +if (calendar_type == GREGORIAN_MARS) mystring = 'GREGORIAN_MARS' +if (calendar_type == SOLAR_MARS) mystring = 'SOLAR_MARS' +if (calendar_type == THIRTY_DAY_MONTHS) mystring = 'THIRTY_DAY_MONTHS' if (len_trim(mystring) < 3) then write(errstring,*)'unknown calendar type ', calendar_type From 697792bb3485abb398f6c8ed16125eaf9f1d78e8 Mon Sep 17 00:00:00 2001 From: Marlee Smith Date: Wed, 6 Nov 2024 15:01:12 -0700 Subject: [PATCH 5/6] Removing found_calendar var and corresponding check --- .../modules/utilities/time_manager_mod.f90 | 20 +++++-------------- 1 file changed, 5 insertions(+), 15 deletions(-) diff --git a/assimilation_code/modules/utilities/time_manager_mod.f90 b/assimilation_code/modules/utilities/time_manager_mod.f90 index c74230dff4..cdc88517aa 100644 --- a/assimilation_code/modules/utilities/time_manager_mod.f90 +++ b/assimilation_code/modules/utilities/time_manager_mod.f90 @@ -665,7 +665,8 @@ end function repeat_alarm !========================================================================= subroutine set_calendar_type_integer(mytype) - +!------------------------------------------------------------------------ +! ! Selects calendar for default mapping from time to date - if you know ! the magic integer for the calendar of interest. @@ -684,7 +685,8 @@ end subroutine set_calendar_type_integer subroutine set_calendar_type_string(calstring) - +!------------------------------------------------------------------------ +! ! Selects calendar for default mapping from time to date - given a string. character(len=*), intent(in) :: calstring @@ -693,7 +695,6 @@ subroutine set_calendar_type_string(calstring) character(len=len(calstring)) :: str1 character(len=max_calendar_string_length) :: cstring -logical :: found_calendar = .false. if ( .not. module_initialized ) call time_manager_init @@ -715,34 +716,23 @@ subroutine set_calendar_type_string(calstring) if ( cstring == 'NO_CALENDAR' ) then calendar_type = NO_CALENDAR - found_calendar = .true. elseif ( cstring == 'NO CALENDAR' ) then ! allow this as a synonym calendar_type = NO_CALENDAR - found_calendar = .true. elseif ( cstring == 'NONE' ) then ! also allow this calendar_type = NO_CALENDAR - found_calendar = .true. elseif ( cstring == 'THIRTY_DAY_MONTHS' ) then calendar_type = THIRTY_DAY_MONTHS - found_calendar = .true. elseif ( cstring == 'JULIAN' ) then calendar_type = JULIAN - found_calendar = .true. elseif ( cstring == 'NOLEAP' ) then calendar_type = NOLEAP - found_calendar = .true. elseif ( cstring == 'GREGORIAN_MARS' ) then calendar_type = GREGORIAN_MARS - found_calendar = .true. elseif ( cstring == 'SOLAR_MARS' ) then calendar_type = SOLAR_MARS - found_calendar = .true. elseif ( cstring == 'GREGORIAN' ) then calendar_type = GREGORIAN - found_calendar = .true. -endif - -if( .not. found_calendar ) then +else write(errstring,*)'Unknown calendar ',calstring call error_handler(E_ERR,'set_calendar_type_string',errstring,source) endif From d0892c49620319f9764af64687ac869e6a61c18f Mon Sep 17 00:00:00 2001 From: Helen Kershaw Date: Fri, 8 Nov 2024 12:54:12 -0500 Subject: [PATCH 6/6] fix: error message to match the routine name --- assimilation_code/modules/utilities/mpi_utilities_mod.f90 | 2 +- assimilation_code/modules/utilities/mpif08_utilities_mod.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/assimilation_code/modules/utilities/mpi_utilities_mod.f90 b/assimilation_code/modules/utilities/mpi_utilities_mod.f90 index d9bd640a38..d091c12638 100644 --- a/assimilation_code/modules/utilities/mpi_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/mpi_utilities_mod.f90 @@ -1475,7 +1475,7 @@ subroutine all_reduce_min_max(min_var, max_var, num_elements) if ( .not. module_initialized ) then write(errstring, *) 'initialize_mpi_utilities() must be called first' - call error_handler(E_ERR,'broadcast_minmax', errstring, source) + call error_handler(E_ERR,'all_reduce_min_max', errstring, source) endif call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode) diff --git a/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 b/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 index 51bc507fe0..b2b1791aa2 100644 --- a/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 +++ b/assimilation_code/modules/utilities/mpif08_utilities_mod.f90 @@ -1475,7 +1475,7 @@ subroutine all_reduce_min_max(min_var, max_var, num_elements) if ( .not. module_initialized ) then write(errstring, *) 'initialize_mpi_utilities() must be called first' - call error_handler(E_ERR,'broadcast_minmax', errstring, source) + call error_handler(E_ERR,'all_reduce_min_max', errstring, source) endif call mpi_allreduce(MPI_IN_PLACE, min_var, num_elements, datasize, MPI_MIN, get_dart_mpi_comm(), errcode)