From 5913e1b9cb73f02187127c7f19aa863e31b9cab9 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 31 Oct 2024 16:41:31 -0700 Subject: [PATCH 01/11] doc(tensor-statistics):update comments/indentation --- demo/app/tensor-statistics.f90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/demo/app/tensor-statistics.f90 b/demo/app/tensor-statistics.f90 index 9a99d1e7d..975c18cc3 100644 --- a/demo/app/tensor-statistics.f90 +++ b/demo/app/tensor-statistics.f90 @@ -25,7 +25,7 @@ elemental function equals(lhs, rhs) result(lhs_equals_rhs) program tensor_statistics !! This program !! 1. Computes the ranges and histograms of input and output tensors saved by - !! the neural-net branch of the Berkeley Lab fork of [ICAR](https://berkeleylab.github/icar). + !! the neural-net branch of the Berkeley Lab fork of [ICAR](https://go.lbl.gov/icar). !! 2. Saves the resulting statistics to text files with space-separated columns and column labels. ! External dependencies: @@ -40,14 +40,14 @@ program tensor_statistics use histogram_m, only : histogram_t, to_file implicit none - character(len=*), parameter :: usage = & - new_line('a') // new_line('a') // & - 'Usage: ' // new_line('a') // new_line('a') // & - './build/run-fpm.sh run tensor-statistics -- \' // new_line('a') // & - ' --base --bins \' // new_line('a') // & + character(len=*), parameter :: usage = new_line('a') // new_line('a') // & + 'Usage: ' // new_line('a') // new_line('a') // & + './build/run-fpm.sh run tensor-statistics -- \' // new_line('a') // & + ' --base --bins \' // new_line('a') // & ' [--raw] [--start ] [--end ] [--stride ]' // & - new_line('a') // new_line('a') // & - 'where angular brackets denote user-provided values and square brackets denote optional arguments.' // new_line('a') + new_line('a') // new_line('a') // & + 'where angular brackets denote user-provided values and square brackets denote optional arguments.' & + // new_line('a') integer(int64) t_start, t_finish, clock_rate integer num_bins, start_step, stride @@ -85,7 +85,7 @@ subroutine get_command_line_arguments(base_name, num_bins, start_step, end_step, type(command_line_t) command_line character(len=:), allocatable :: stride_string, bins_string, start_string, end_string - base_name = command_line%flag_value("--base") ! gfortran 13 seg faults if this is an association + base_name = command_line%flag_value("--base") bins_string = command_line%flag_value("--bins") start_string = command_line%flag_value("--start") end_string = command_line%flag_value("--end") From bdab1d8da300389711b9414e51a7ea1ff1ed61d8 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 31 Oct 2024 17:58:56 -0700 Subject: [PATCH 02/11] refac(train-cloud): mv default-val handling to src --- demo/app/train-cloud-microphysics.F90 | 49 +++++++-------------------- 1 file changed, 12 insertions(+), 37 deletions(-) diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index 93ad7b79d..4fdac00bf 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -1,11 +1,10 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt program train_cloud_microphysics - !! Train a neural network to represent the simplest cloud microphysics model from - !! the Intermediate Complexity Atmospheric Research Model (ICAR) at - !! https://github.com/BerkeleyLab/icar. + !! Train a neural network to represent a cloud microphysics model from + !! [ICAR](https://go.lbl.gov/icar)) - !! Intrinic modules : + !! Intrinsic modules : use iso_fortran_env, only : int64, real64 !! External dependencies: @@ -20,6 +19,8 @@ program train_cloud_microphysics use NetCDF_file_m, only: NetCDF_file_t use NetCDF_variable_m, only: NetCDF_variable_t, tensors use occupancy_m, only : occupancy_t + use default_value_or_internal_read_m, only : default_value_or_internal_read + implicit none character(len=*), parameter :: usage = new_line('a') // new_line('a') // & @@ -29,7 +30,7 @@ program train_cloud_microphysics ' [--start ] [--end ] [--stride ] [--bins ] [--report ] [--tolerance ]'// & new_line('a') // new_line('a') // & 'where angular brackets denote user-provided values and square brackets denote optional arguments.' // new_line('a') // & - 'The presence of a file named "stop" halts execution gracefully.' + 'The presence of a file named "stop" halts execution gracefully.' // new_line('') type command_line_arguments_t integer num_epochs, start_step, stride, num_bins, report_step @@ -108,7 +109,7 @@ function get_command_line_arguments() result(command_line_arguments) integer, allocatable :: end_step integer num_epochs, num_bins, start_step, stride, report_step - base_name = command_line%flag_value("--base") ! gfortran 13 seg faults if this is an association + base_name = command_line%flag_value("--base") epochs_string = command_line%flag_value("--epochs") start_string = command_line%flag_value("--start") end_string = command_line%flag_value("--end") @@ -123,11 +124,11 @@ function get_command_line_arguments() result(command_line_arguments) read(epochs_string,*) num_epochs - stride = default_integer_or_read(1, stride_string) - start_step = default_integer_or_read(1, start_string) - report_step = default_integer_or_read(1, report_string) - num_bins = default_integer_or_read(3, bins_string) - cost_tolerance = default_real_or_read(5E-8, tolerance_string) + stride = default_value_or_internal_read(1, stride_string) + start_step = default_value_or_internal_read(1, start_string) + report_step = default_value_or_internal_read(1, report_string) + num_bins = default_value_or_internal_read(3, bins_string) + cost_tolerance = default_value_or_internal_read(5E-8, tolerance_string) if (len(end_string)/=0) then allocate(end_step) @@ -436,30 +437,4 @@ subroutine read_train_write(training_configuration, args, plot_file) end subroutine read_train_write - pure function default_integer_or_read(default, string) result(set_value) - integer, intent(in) :: default - character(len=*), intent(in) :: string - integer set_value - - if (len(string)==0) then - set_value = default - else - read(string,*) set_value - end if - - end function - - pure function default_real_or_read(default, string) result(set_value) - real, intent(in) :: default - character(len=*), intent(in) :: string - real set_value - - if (len(string)==0) then - set_value = default - else - read(string,*) set_value - end if - - end function - end program train_cloud_microphysics From d23fa0b5c5ccd99f2b318cfbf543d175b9c8e4d1 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 31 Oct 2024 18:00:45 -0700 Subject: [PATCH 03/11] chore(train-cloud): edit indentations --- demo/app/train-cloud-microphysics.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index 4fdac00bf..de2eb04a2 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -23,14 +23,14 @@ program train_cloud_microphysics implicit none - character(len=*), parameter :: usage = new_line('a') // new_line('a') // & - 'Usage: ' // new_line('a') // new_line('a') // & - './build/run-fpm.sh run train-cloud-microphysics -- \' // new_line('a') // & - ' --base --epochs \' // new_line('a') // & + character(len=*), parameter :: usage = new_line('') // new_line('') // & + 'Usage: ' // new_line('') // new_line('') // & + './build/run-fpm.sh run train-cloud-microphysics -- \' // new_line('') // & + ' --base --epochs \' // new_line('') // & ' [--start ] [--end ] [--stride ] [--bins ] [--report ] [--tolerance ]'// & - new_line('a') // new_line('a') // & - 'where angular brackets denote user-provided values and square brackets denote optional arguments.' // new_line('a') // & - 'The presence of a file named "stop" halts execution gracefully.' // new_line('') + new_line('') // new_line('') // & + 'where angular brackets denote user-provided values and square brackets denote optional arguments.' // new_line('') // & + 'The presence of a file named "stop" halts execution gracefully.' // new_line('') type command_line_arguments_t integer num_epochs, start_step, stride, num_bins, report_step From 30b585d802d8cf124b6bde093394794412cdbb61 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 11:51:24 -0500 Subject: [PATCH 04/11] chore(fpm.toml): update Assert dependency to 2.0.0 --- demo/fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/fpm.toml b/demo/fpm.toml index 729eb03ac..01aa82e17 100644 --- a/demo/fpm.toml +++ b/demo/fpm.toml @@ -4,7 +4,7 @@ author = "(Please see fiats/fpm.toml.)" maintainer = "(Please see fiats/fpm.toml.)" [dependencies] -assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.7.0"} +assert = {git = "https://github.com/sourceryinstitute/assert", tag = "2.0.0"} julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.5.3"} fiats = {path = "../"} netcdf-interfaces = {git = "https://github.com/LKedward/netcdf-interfaces.git", rev = "d2bbb71ac52b4e346b62572b1ca1620134481096"} From f0daa5863ba08f7dae46c0428b01b5cd9f619b6b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 13:47:13 -0500 Subject: [PATCH 05/11] feat(demo): def/use default-value handlers This commit gathers the logic for setting run parameters based on the presence of an optional value or a non-zero length character string from which the value can be read. The commit defines and uses two new functions: * default_or_internal_read * default_or_present_value --- demo/app/train-cloud-microphysics.F90 | 12 +++---- demo/src/NetCDF_variable_s.f90 | 36 +++----------------- demo/src/default_m.f90 | 49 +++++++++++++++++++++++++++ demo/src/default_s.f90 | 46 +++++++++++++++++++++++++ 4 files changed, 105 insertions(+), 38 deletions(-) create mode 100644 demo/src/default_m.f90 create mode 100644 demo/src/default_s.f90 diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index de2eb04a2..5813b4249 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -19,7 +19,7 @@ program train_cloud_microphysics use NetCDF_file_m, only: NetCDF_file_t use NetCDF_variable_m, only: NetCDF_variable_t, tensors use occupancy_m, only : occupancy_t - use default_value_or_internal_read_m, only : default_value_or_internal_read + use default_m, only: default_or_internal_read implicit none @@ -124,11 +124,11 @@ function get_command_line_arguments() result(command_line_arguments) read(epochs_string,*) num_epochs - stride = default_value_or_internal_read(1, stride_string) - start_step = default_value_or_internal_read(1, start_string) - report_step = default_value_or_internal_read(1, report_string) - num_bins = default_value_or_internal_read(3, bins_string) - cost_tolerance = default_value_or_internal_read(5E-8, tolerance_string) + stride = default_or_internal_read(1, stride_string) + start_step = default_or_internal_read(1, start_string) + report_step = default_or_internal_read(1, report_string) + num_bins = default_or_internal_read(3, bins_string) + cost_tolerance = default_or_internal_read(5E-8, tolerance_string) if (len(end_string)/=0) then allocate(end_step) diff --git a/demo/src/NetCDF_variable_s.f90 b/demo/src/NetCDF_variable_s.f90 index 6c18e0f98..f85213601 100644 --- a/demo/src/NetCDF_variable_s.f90 +++ b/demo/src/NetCDF_variable_s.f90 @@ -4,6 +4,7 @@ use ieee_arithmetic, only : ieee_is_nan use kind_parameters_m, only : default_real use assert_m, only : assert, intrinsic_array_t + use default_m, only : default_or_present_value implicit none interface components_allocated @@ -21,11 +22,6 @@ module procedure double_precision_upper_bounds end interface - interface default_if_not_present - module procedure default_integer_if_not_present - module procedure default_real_if_not_present - end interface - contains module procedure default_real_copy @@ -429,9 +425,9 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) select case(NetCDF_variables(1)%rank()) case(4) - t_start = default_if_not_present(1, step_start ) - t_stride = default_if_not_present(1, step_stride) - t_end = default_if_not_present(size(NetCDF_variables(1)%values_4D_,4), step_end) + t_start = default_or_present_value(1, step_start ) + t_stride = default_or_present_value(1, step_stride) + t_end = default_or_present_value(size(NetCDF_variables(1)%values_4D_,4), step_end) associate( longitudes => size(NetCDF_variables(1)%values_4D_,1) & ,latitudes => size(NetCDF_variables(1)%values_4D_,2) & @@ -541,28 +537,4 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) end select end procedure - pure function default_integer_if_not_present(default_value, optional_argument) result(set_value) - integer, intent(in) :: default_value - integer, intent(in), optional :: optional_argument - integer set_value - - if (present(optional_argument)) then - set_value = optional_argument - else - set_value = default_value - end if - end function - - pure function default_real_if_not_present(default_value, optional_argument) result(set_value) - real, intent(in) :: default_value - real, intent(in), optional :: optional_argument - real set_value - - if (present(optional_argument)) then - set_value = optional_argument - else - set_value = default_value - end if - end function - end submodule NetCDF_variable_s \ No newline at end of file diff --git a/demo/src/default_m.f90 b/demo/src/default_m.f90 new file mode 100644 index 000000000..61ac6356a --- /dev/null +++ b/demo/src/default_m.f90 @@ -0,0 +1,49 @@ +module default_m + !! Define functions to choose between default values and alternative values + implicit none + + private + public :: default_or_internal_read + public :: default_or_present_value + + interface default_or_internal_read + + pure module function default_integer_or_internal_read(default_value, string) result(set_value) + !! result is read from string if len(string)/=0, default_value otherwise + implicit none + integer, intent(in) :: default_value + character(len=*), intent(in) :: string + integer set_value + end function + + pure module function default_real_or_internal_read(default_value, string) result(set_value) + !! result is read from string if len(string)/=0, default_value otherwise + implicit none + real, intent(in) :: default_value + character(len=*), intent(in) :: string + real set_value + end function + + end interface + + interface default_or_present_value + + pure module function default_integer_or_present_value(default_value, optional_value) result(set_value) + !! result is default_value if optional_value not present, optional_value otherwise + implicit none + integer, intent(in) :: default_value + integer, intent(in), optional :: optional_value + integer set_value + end function + + pure module function default_real_or_present_value(default_value, optional_value) result(set_value) + !! result is default_value if optional_value not present, optional_value otherwise + implicit none + real, intent(in) :: default_value + real, intent(in), optional :: optional_value + real set_value + end function + + end interface + +end module diff --git a/demo/src/default_s.f90 b/demo/src/default_s.f90 new file mode 100644 index 000000000..51d362a1e --- /dev/null +++ b/demo/src/default_s.f90 @@ -0,0 +1,46 @@ +submodule(default_m) default_s + implicit none + +contains + + module procedure default_integer_or_present_value + + if (present(optional_value)) then + set_value = optional_value + else + set_value = default_value + end if + + end procedure + + module procedure default_real_or_present_value + + if (present(optional_value)) then + set_value = optional_value + else + set_value = default_value + end if + + end procedure + + module procedure default_integer_or_internal_read + + if (len(string)/=0) then + read(string,*) set_value + else + set_value = default_value + end if + + end procedure + + module procedure default_real_or_internal_read + + if (len(string)/=0) then + read(string,*) set_value + else + set_value = default_value + end if + + end procedure + +end submodule default_s \ No newline at end of file From b29c8dac7e92ebffefcbaf6113ffade494cb7d4a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 13:52:54 -0500 Subject: [PATCH 06/11] feat(demo/app): invoke assertions via macros This commit switches the assertions in demo/app programs train-cloud-microphysics and tensor-statistics to invocations via the Assert 2.0.0 macros, which facilitates the assertions' complete removal when the ASSERTIONS macro is undefined or non-zero. --- ...r-statistics.f90 => tensor-statistics.F90} | 22 ++++++++++--------- demo/app/train-cloud-microphysics.F90 | 13 ++++++----- 2 files changed, 20 insertions(+), 15 deletions(-) rename demo/app/{tensor-statistics.f90 => tensor-statistics.F90} (92%) diff --git a/demo/app/tensor-statistics.f90 b/demo/app/tensor-statistics.F90 similarity index 92% rename from demo/app/tensor-statistics.f90 rename to demo/app/tensor-statistics.F90 index 975c18cc3..c00f74c1a 100644 --- a/demo/app/tensor-statistics.f90 +++ b/demo/app/tensor-statistics.F90 @@ -1,6 +1,8 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt +#include "assert_macros.h" + module ubounds_m !! This module serves only to support array bounds checking in the main program below implicit none @@ -30,14 +32,14 @@ program tensor_statistics ! External dependencies: use julienne_m, only : command_line_t, file_t, string_t - use assert_m, only : assert, intrinsic_array_t + use assert_m use ubounds_m, only : ubounds_t use ieee_arithmetic, only : ieee_is_nan use iso_fortran_env, only : int64, real64 ! Internal dependencies: use NetCDF_file_m, only: NetCDF_file_t - use histogram_m, only : histogram_t, to_file + use histogram_m, only: histogram_t, to_file implicit none character(len=*), parameter :: usage = new_line('a') // new_line('a') // & @@ -204,9 +206,9 @@ subroutine compute_histograms(base_name, raw) lbounds = [lbounds, lbound(qv_out), lbound(qc_out), lbound(qr_out), lbound(qs_out)] ubounds = [ubounds, ubounds_t(ubound(qv_out)), ubounds_t(ubound(qc_out)), & ubounds_t(ubound(qr_out)), ubounds_t(ubound(qs_out))] - call assert(all(lbounds == 1), "main: default input/output lower bounds", intrinsic_array_t(lbounds)) - call assert(all(ubounds == ubounds(1)), "main: matching input/output upper bounds") - call assert(all(abs(time_in(2:t_end) - time_out(1:t_end-1)) "d" // output_names(v)%string() // "/dt") print *,"- " // derivative_name derivative(v) = NetCDF_variable_t( (input_variable(v) - output_variable(v)) / dt, derivative_name) - call assert(.not. derivative(v)%any_nan(), "train_cloud_microhphysics: non NaN's") + call_assert(.not. derivative(v)%any_nan()) end associate derivative_name end do end associate dt From 057a3db952c25fc24d4396ed56ea3333904ae5e5 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 16:00:31 -0500 Subject: [PATCH 07/11] feat(demo/src): invoke assertions via macros --- .../{NetCDF_file_s.f90 => NetCDF_file_s.F90} | 81 ++++++++----------- ...F_variable_s.f90 => NetCDF_variable_s.F90} | 29 ++++--- demo/src/{histogram_s.f90 => histogram_s.F90} | 16 ++-- demo/src/{occupancy_s.f90 => occupancy_s.F90} | 10 ++- 4 files changed, 66 insertions(+), 70 deletions(-) rename demo/src/{NetCDF_file_s.f90 => NetCDF_file_s.F90} (61%) rename demo/src/{NetCDF_variable_s.f90 => NetCDF_variable_s.F90} (91%) rename demo/src/{histogram_s.f90 => histogram_s.F90} (90%) rename demo/src/{occupancy_s.f90 => occupancy_s.F90} (96%) diff --git a/demo/src/NetCDF_file_s.f90 b/demo/src/NetCDF_file_s.F90 similarity index 61% rename from demo/src/NetCDF_file_s.f90 rename to demo/src/NetCDF_file_s.F90 index e1b40908a..453058479 100644 --- a/demo/src/NetCDF_file_s.f90 +++ b/demo/src/NetCDF_file_s.F90 @@ -1,11 +1,14 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + submodule(netCDF_file_m) netCDF_file_s use netcdf, only : & nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions nf90_close, nf90_open, nf90_inq_varid, nf90_get_var, nf90_inquire_variable, & nf90_clobber, nf90_noerr, nf90_strerror, nf90_int, nf90_nowrite ! constants - use assert_m, only : assert, intrinsic_array_t + use assert_m implicit none contains @@ -25,21 +28,18 @@ function get_shape(ncid, varname) result(array_shape) integer,dimension(max_rank+1) :: dims, dimIds associate(nf_status => nf90_inq_varid(ncid, varname, varid)) write(varid_string, *) varid - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & - diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inq_varid " // trim(nf90_strerror(nf_status)), diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) end associate associate(nf_status => nf90_inquire_variable(ncid, varid, ndims = var_rank)) - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), & - trim(nf90_strerror(nf_status)) // "(" // varname // ")") + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), trim(nf90_strerror(nf_status)) // "(" // varname // ")") + end associate associate(nf_status => nf90_inquire_variable(ncid, varid, dimids = dimIds(:var_rank))) - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), & - trim(nf90_strerror(nf_status)) // "(" // varname // ")") + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), trim(nf90_strerror(nf_status)) // "(" // varname // ")") end associate do i=1,var_rank associate(nf_status => nf90_inquire_dimension(ncid, dimIds(i), len = dimlen)) - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_dimension" // trim(nf90_strerror(nf_status)),& - trim(nf90_strerror(nf_status)) // "(" // varname // ")") + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_dimension" // trim(nf90_strerror(nf_status)), trim(nf90_strerror(nf_status)) // "(" // varname // ")") end associate dims(i+1)=dimlen end do @@ -52,48 +52,46 @@ function get_shape(ncid, varname) result(array_shape) integer ncid, varid associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces - call assert(nf_status == nf90_noerr, & - "Net_CDF_file_m(input_integer): nf90_open" // trim(nf90_strerror(nf_status)), & - diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_) + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(input_integer): nf90_open" // trim(nf90_strerror(nf_status)), diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_) end associate associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID write(varid_string, *) varid - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_integer): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & - diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(input_integer): nf90_inq_varid " // trim(nf90_strerror(nf_status)), diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + end associate select rank(values) rank(1) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_integer): size(array_shape)==rank(values)") + call_assert(size(array_shape)==rank(values)) allocate(values(array_shape(1))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) end associate end associate rank(2) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_integer): size(array_shape)==rank(values)") + call_assert(size(array_shape)==rank(values)) allocate(values(array_shape(1), array_shape(2))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) end associate end associate rank(3) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_integer): size(array_shape)==rank(values)") + call_assert(size(array_shape)==rank(values)) allocate(values(array_shape(1), array_shape(2), array_shape(3))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) end associate end associate rank(4) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_integer): size(array_shape)==rank(values)") + call_assert(size(array_shape)==rank(values)) allocate(values(array_shape(1), array_shape(2), array_shape(3), array_shape(4))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "NetCDF_file_s(input_integer): nf90_get_var", trim(nf90_strerror(nf_status))) end associate end associate rank default @@ -107,51 +105,45 @@ function get_shape(ncid, varname) result(array_shape) integer ncid, varid associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces - call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", & - trim(nf90_strerror(nf_status)) // self%file_name_) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", trim(nf90_strerror(nf_status)) // self%file_name_) end associate associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID write(varid_string, *) varid - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_double): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & - diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(input_double): nf90_inq_varid " // trim(nf90_strerror(nf_status)), diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) end associate select rank(values) rank(1) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(2) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1),array_shape(2))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(3) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1),array_shape(2),array_shape(3))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(4) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_double): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1),array_shape(2),array_shape(3),array_shape(4))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank default @@ -165,29 +157,26 @@ function get_shape(ncid, varname) result(array_shape) integer ncid, varid associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces - call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", & - trim(nf90_strerror(nf_status)) // self%file_name_) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", trim(nf90_strerror(nf_status)) // self%file_name_) end associate associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID write(varid_string, *) varid - call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), & - diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) + call_assert_diagnose(nf_status == nf90_noerr, "Net_CDF_file_m(input_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string))) end associate select rank(values) rank(0) allocate(values) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, values)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, values)", trim(nf90_strerror(nf_status))) end associate rank(1) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(2) diff --git a/demo/src/NetCDF_variable_s.f90 b/demo/src/NetCDF_variable_s.F90 similarity index 91% rename from demo/src/NetCDF_variable_s.f90 rename to demo/src/NetCDF_variable_s.F90 index f85213601..c2a3d5c68 100644 --- a/demo/src/NetCDF_variable_s.f90 +++ b/demo/src/NetCDF_variable_s.F90 @@ -1,9 +1,12 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + submodule(NetCDF_variable_m) NetCDF_variable_s use ieee_arithmetic, only : ieee_is_nan use kind_parameters_m, only : default_real - use assert_m, only : assert, intrinsic_array_t + use assert_m use default_m, only : default_or_present_value implicit none @@ -138,14 +141,14 @@ pure function double_precision_components_allocated(NetCDF_variable) result(allo module procedure default_real_rank associate(allocation_vector => components_allocated(self)) - call assert(count(allocation_vector) == 1, "NetCDF_variable_s(default_real_rank): allocation count") + call_assert(count(allocation_vector) == 1) my_rank = findloc(allocation_vector, .true., dim=1) end associate end procedure module procedure double_precision_rank associate(allocation_vector => components_allocated(self)) - call assert(count(allocation_vector) == 1, "NetCDF_variable_s(double_precision_rank): allocation count") + call_assert(count(allocation_vector) == 1) my_rank = findloc(allocation_vector, .true., dim=1) end associate end procedure @@ -262,8 +265,8 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) module procedure default_real_subtract - call assert(lhs%conformable_with(rhs), "NetCDF_variable_s(default_real_subtract): lhs%conformable_with(rhs)") - call assert(lhs%name_==rhs%name_, "NetCDF_variable_s(default_real_subtract): lhs%name_==rhs%name_", lhs%name_//"/="//rhs%name_) + call_assert(lhs%conformable_with(rhs)) + call_assert_diagnose(lhs%name_==rhs%name_, "NetCDF_variable_s(default_real_subtract): lhs%name_==rhs%name_", lhs%name_//"/="//rhs%name_) difference%name_ = lhs%name_ @@ -283,8 +286,8 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) module procedure double_precision_subtract - call assert(lhs%conformable_with(rhs), "NetCDF_variable_s(double_precision_subtract): lhs%conformable_with(rhs)") - call assert(lhs%name_ == rhs%name_, "NetCDF_variable_s(double_precision_subtract): lhs%name_==rhs%name_",lhs%name_//"/="//rhs%name_) + call_assert(lhs%conformable_with(rhs)) + call_assert_diagnose(lhs%name_ == rhs%name_, "NetCDF_variable_s(double_precision_subtract): lhs%name_==rhs%name_",lhs%name_//"/="//rhs%name_) difference%name_ = lhs%name_ @@ -306,14 +309,14 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) integer t - call assert(rhs%rank()==1, "NetCDF_variable_s(default_real_divide): rhs%rank()==1") + call_assert(rhs%rank()==1) associate(t_end => size(rhs%values_1D_)) select case(lhs%rank()) case(4) - call assert(size(rhs%values_1D_) == size(lhs%values_4D_,4), "NetCDF_variable_s(default_real_divide): conformable numerator/denominator") + call_assert_describe(size(rhs%values_1D_) == size(lhs%values_4D_,4), "NetCDF_variable_s(default_real_divide): conformable numerator/denominator") allocate(ratio%values_4D_, mold = lhs%values_4D_) do concurrent(t = 1:t_end) @@ -332,14 +335,14 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) integer t - call assert(rhs%rank()==1, "NetCDF_variable_s(double_precision_divide): rhs%rank()==1") + call_assert(rhs%rank()==1) associate(t_end => size(rhs%values_1D_)) select case(lhs%rank()) case(4) - call assert(size(rhs%values_1D_) == size(lhs%values_4D_,4), "NetCDF_variable_s(double_precision_divide): conformable numerator/denominator") + call_assert_describe(size(rhs%values_1D_) == size(lhs%values_4D_,4), "NetCDF_variable_s(double_precision_divide): conformable numerator/denominator") allocate(ratio%values_4D_, mold = lhs%values_4D_) do concurrent(t = 1:t_end) @@ -367,7 +370,7 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) case default error stop "NetCDF_variable_s(default_real_assign): unsupported rank)" end select - call assert(lhs%rank()==rhs%rank(), "NetCDF_variable_s(default_real_assign): ranks match)") + call_assert(lhs%rank()==rhs%rank()) end procedure module procedure double_precision_assign @@ -383,7 +386,7 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) case default error stop "NetCDF_variable_s(double_precision_assign): unsupported rank)" end select - call assert(lhs%rank()==rhs%rank(), "NetCDF_variable_s(double_precision_assign): ranks match)") + call_assert(lhs%rank()==rhs%rank()) end procedure module procedure default_real_any_nan diff --git a/demo/src/histogram_s.f90 b/demo/src/histogram_s.F90 similarity index 90% rename from demo/src/histogram_s.f90 rename to demo/src/histogram_s.F90 index a8936118d..59d18af17 100644 --- a/demo/src/histogram_s.f90 +++ b/demo/src/histogram_s.F90 @@ -1,7 +1,10 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + submodule(histogram_m) histogram_s - use assert_m, only : assert, intrinsic_array_t + use assert_m use julienne_m, only : string_t, operator(.cat.) implicit none @@ -73,10 +76,9 @@ block integer h, b ! histogram number, bin number - call assert(num_bins > 0, "histogram_s(to_file): num_bins > 0") - call assert(all(histograms(1)%num_bins() == [(histograms(h)%num_bins() , h=1,size(histograms))]), & - "histogram_s(to_file): uniform number of bins") - + call_assert(num_bins > 0) + call_assert_describe(all(histograms(1)%num_bins() == [(histograms(h)%num_bins() , h=1,size(histograms))]), "histogram_s(to_file): uniform number of bins") + allocate(columns(num_bins)) do b = 1, num_bins columns(b) = string_t(histograms(1)%bin_value_(b)) // & @@ -95,7 +97,7 @@ pure function normalize(x, x_min, x_max) result(x_normalized) real, intent(in) :: x(:,:,:,:), x_min, x_max real, allocatable :: x_normalized(:,:,:,:) - call assert(x_min/=x_max, "histogram_m(normalize): x_min/=x_max", intrinsic_array_t([x_min, x_max])) + call_assert_diagnose(x_min/=x_max, "histogram_m(normalize): x_min/=x_max", intrinsic_array_t([x_min, x_max])) x_normalized = (x - x_min)/(x_max - x_min) end function @@ -150,7 +152,7 @@ pure function normalize(x, x_min, x_max) result(x_normalized) end associate end associate associate(binned => sum(bin_count)) - call assert(cardinality == binned, "histogram_s(construct): lossless binning", intrinsic_array_t([cardinality, binned])) + call_assert_diagnose(cardinality == binned, "histogram_s(construct): lossless binning", intrinsic_array_t([cardinality, binned])) end associate end associate diff --git a/demo/src/occupancy_s.f90 b/demo/src/occupancy_s.F90 similarity index 96% rename from demo/src/occupancy_s.f90 rename to demo/src/occupancy_s.F90 index 3b4e4a44e..0e7d8f1c2 100644 --- a/demo/src/occupancy_s.f90 +++ b/demo/src/occupancy_s.F90 @@ -1,5 +1,7 @@ +#include "assert_macros.h" + submodule(occupancy_m) occupancy_s - use assert_m, only : assert, intrinsic_array_t + use assert_m implicit none contains @@ -81,7 +83,7 @@ end function allocations error stop "occupancy_s(vacate): unsupported rank" end select - call assert(self%allocated_dim()==size(dims), "occupancy_s(vacate): count(self%allocations()) == 1") + call_assert(self%allocated_dim()==size(dims)) end procedure vacate @@ -171,7 +173,7 @@ end function allocations module procedure num_occupied - call assert(count(allocations(self))==1, "occupancy_s(allocated_dim): count(self%allocations()) == 1") + call_assert(count(allocations(self))==1) select case(self%allocated_dim()) case(1) @@ -252,7 +254,7 @@ end function allocations module procedure allocated_dim associate(my_allocations => allocations(self)) - call assert(count(my_allocations)==1, "occupancy_s(allocated_dim): count(self%allocations()) == 1") + call_assert(count(my_allocations)==1) my_dim = findloc(my_allocations, .true., dim=1) end associate From 22ebdc92d0344cdc47f2b36970fa9bd49668df66 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 16:18:55 -0500 Subject: [PATCH 08/11] chore(demo/src): add missing copyright headers --- demo/src/NetCDF_file_s.F90 | 15 ++++++--------- demo/src/default_m.f90 | 2 ++ demo/src/default_s.f90 | 2 ++ demo/src/occupancy_m.f90 | 2 ++ demo/src/occupancy_s.F90 | 3 +++ 5 files changed, 15 insertions(+), 9 deletions(-) diff --git a/demo/src/NetCDF_file_s.F90 b/demo/src/NetCDF_file_s.F90 index 453058479..cd5926a87 100644 --- a/demo/src/NetCDF_file_s.F90 +++ b/demo/src/NetCDF_file_s.F90 @@ -181,29 +181,26 @@ function get_shape(ncid, varname) result(array_shape) end associate rank(2) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1), array_shape(2))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(3) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1), array_shape(2), array_shape(3))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank(4) associate(array_shape => get_shape(ncid, varname)) - call assert(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", & - intrinsic_array_t([size(array_shape),rank(values)])) + call_assert_diagnose(size(array_shape)==rank(values), "netCDF_file_s(input_real): size(array_shape)==rank(values)", intrinsic_array_t([size(array_shape),rank(values)])) allocate(values(array_shape(1), array_shape(2), array_shape(3), array_shape(4))) associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data - call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status))) end associate end associate rank default diff --git a/demo/src/default_m.f90 b/demo/src/default_m.f90 index 61ac6356a..de6f6153c 100644 --- a/demo/src/default_m.f90 +++ b/demo/src/default_m.f90 @@ -1,3 +1,5 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt module default_m !! Define functions to choose between default values and alternative values implicit none diff --git a/demo/src/default_s.f90 b/demo/src/default_s.f90 index 51d362a1e..bb29142bc 100644 --- a/demo/src/default_s.f90 +++ b/demo/src/default_s.f90 @@ -1,3 +1,5 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt submodule(default_m) default_s implicit none diff --git a/demo/src/occupancy_m.f90 b/demo/src/occupancy_m.f90 index 15b2ef247..e095c19c9 100644 --- a/demo/src/occupancy_m.f90 +++ b/demo/src/occupancy_m.f90 @@ -1,3 +1,5 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt module occupancy_m use iso_fortran_env, only : int64 implicit none diff --git a/demo/src/occupancy_s.F90 b/demo/src/occupancy_s.F90 index 0e7d8f1c2..a8720d0b5 100644 --- a/demo/src/occupancy_s.F90 +++ b/demo/src/occupancy_s.F90 @@ -1,3 +1,6 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt + #include "assert_macros.h" submodule(occupancy_m) occupancy_s From 4fc223f7dc67493d4a3770bda645afedc4e3f95f Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 16:21:27 -0500 Subject: [PATCH 09/11] build(netCDF_file_test): build with ifx This commit removes the macro that effectively removed the file demo/test/netCDF_file_test_m.F90 when building with the Intel ifx compiler. --- .../test/{netCDF_file_test_m.f90 => netCDF_file_test_m.F90} | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) rename demo/test/{netCDF_file_test_m.f90 => netCDF_file_test_m.F90} (96%) diff --git a/demo/test/netCDF_file_test_m.f90 b/demo/test/netCDF_file_test_m.F90 similarity index 96% rename from demo/test/netCDF_file_test_m.f90 rename to demo/test/netCDF_file_test_m.F90 index 536e92e92..2da24b370 100644 --- a/demo/test/netCDF_file_test_m.f90 +++ b/demo/test/netCDF_file_test_m.F90 @@ -1,8 +1,5 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt -#ifndef __INTEL_FORTRAN -!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro -!! effectively eliminates this file's source code when building with an Intel compiler. module NetCDF_file_test_m !! Define asymmetric tests for the NetCDF file interface @@ -155,5 +152,4 @@ function write_then_read_1D_double() result(test_passes) end function -end module NetCDF_file_test_m -#endif // __INTEL_FORTRAN \ No newline at end of file +end module NetCDF_file_test_m \ No newline at end of file From fdbf65a664108a2bf7f468a7209a5d85467c2a26 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 16:27:01 -0500 Subject: [PATCH 10/11] feat(demo/test): invoke assertions via macros --- demo/test/{main.f90 => main.F90} | 0 demo/test/netCDF_file_test_m.F90 | 35 ++++++++++++++++---------------- 2 files changed, 18 insertions(+), 17 deletions(-) rename demo/test/{main.f90 => main.F90} (100%) diff --git a/demo/test/main.f90 b/demo/test/main.F90 similarity index 100% rename from demo/test/main.f90 rename to demo/test/main.F90 diff --git a/demo/test/netCDF_file_test_m.F90 b/demo/test/netCDF_file_test_m.F90 index 2da24b370..db6555f80 100644 --- a/demo/test/netCDF_file_test_m.F90 +++ b/demo/test/netCDF_file_test_m.F90 @@ -1,10 +1,13 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + module NetCDF_file_test_m !! Define asymmetric tests for the NetCDF file interface ! External dependencies - use assert_m, only : assert + use assert_m use julienne_m, only : string_t, test_t, test_result_t use netcdf, only : & nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions @@ -53,7 +56,7 @@ function results() result(test_results) write_then_read_1D_double() & ] & ) - call assert(size(descriptions) == size(outcomes),"asymmetric_engine_test_m(results): size(descriptions) == size(outcomes)") + call_assert(size(descriptions) == size(outcomes)) test_results = test_result_t(descriptions, outcomes) end associate @@ -66,26 +69,25 @@ subroutine output_2D_integer(file_name, data_out) integer ncid, varid, x_dimid, y_dimid associate(nf_status => nf90_create(file_name, nf90_clobber, ncid)) ! create or ovewrite file - call assert(nf_status == nf90_noerr, "nf90_create(file_name, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_create(file_name, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_def_dim(ncid, "x", size(data_out,2), x_dimid)) ! define x dimension & get its ID - call assert(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_def_dim(ncid, "y", size(data_out,1), y_dimid)) ! define y dimension & get its ID - call assert(nf_status==nf90_noerr, 'nf90_def_dim(ncid,"y",size(data_out,2),y_dimid) succeeds', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status==nf90_noerr, 'nf90_def_dim(ncid,"y",size(data_out,2),y_dimid) succeeds', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_def_var(ncid, "data", nf90_int, [y_dimid, x_dimid], varid))!define integer 'data' variable & get ID - call assert(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', & - trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_enddef(ncid)) ! exit define mode: tell NetCDF we are done defining metadata - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_put_var(ncid, varid, data_out)) ! write all data to file - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_close(ncid)) ! close file to free associated NetCDF resources and flush buffers - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) end associate end subroutine @@ -96,23 +98,22 @@ subroutine output_1D_double(file_name, data_out) integer ncid, varid, x_dimid, y_dimid associate(nf_status => nf90_create(file_name, nf90_clobber, ncid)) ! create or ovewrite file - call assert(nf_status == nf90_noerr, "nf90_create(file_name, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, "nf90_create(file_name, nf90_clobber, ncid) succeeds",trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_def_dim(ncid, "x", size(data_out,1), x_dimid)) ! define x dimension & get its ID - call assert(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr,'nf90_def_dim(ncid,"x",size(data_out,2),x_dimid) succeeds',trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_def_var(ncid, "data", nf90_int, [x_dimid], varid))!define integer 'data' variable & get ID - call assert(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', & - trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nf90_def_var(ncid,"data",nf90_int,[y_dimid,x_dimid],varid) succeds', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_enddef(ncid)) ! exit define mode: tell NetCDF we are done defining metadata - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_enddef(ncid)', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_put_var(ncid, varid, data_out)) ! write all data to file - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_put_var(ncid, varid, data_out)', trim(nf90_strerror(nf_status))) end associate associate(nf_status => nf90_close(ncid)) ! close file to free associated NetCDF resources and flush buffers - call assert(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) + call_assert_diagnose(nf_status == nf90_noerr, 'nff90_noerr == nf90_close(ncid)', trim(nf90_strerror(nf_status))) end associate end subroutine From 36226ea1c6b46153940c683b49f9806dfde1e150 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Thu, 28 Nov 2024 17:27:02 -0500 Subject: [PATCH 11/11] test(demo): enable selective testing --- demo/test/main.F90 | 30 +++++++++++++++++++++--------- demo/test/netCDF_file_test_m.F90 | 30 ++++++++++++++---------------- 2 files changed, 35 insertions(+), 25 deletions(-) diff --git a/demo/test/main.F90 b/demo/test/main.F90 index 43792108b..142657420 100644 --- a/demo/test/main.F90 +++ b/demo/test/main.F90 @@ -5,21 +5,33 @@ program main use netCDF_file_test_m, only : netCDF_file_test_t + use iso_fortran_env, only : int64, real64 + use julienne_m, only : command_line_t implicit none - real t_start, t_finish - + integer(int64) t_start, t_finish, clock_rate + type(netCDF_file_test_t) netCDF_file_test integer :: passes=0, tests=0 - call cpu_time(t_start) - block - type(netCDF_file_test_t) netCDF_file_test - call netCDF_file_test%report(passes, tests) - end block - call cpu_time(t_finish) + print_usage_if_help_requested: & + block + type(command_line_t) command_line + character(len=*), parameter :: usage = & + new_line('') // new_line('') // & + 'Usage: fpm test -- [--help] | [--contains ]' // & + new_line('') // new_line('') // & + 'where square brackets ([]) denote optional arguments, a pipe (|) separates alternative arguments,' // new_line('') // & + 'angular brackets (<>) denote a user-provided value, and passing a substring limits execution to' // new_line('') // & + 'the tests with test subjects or test descriptions containing the user-specified substring.' // new_line('') + if (command_line%argument_present([character(len=len("--help"))::"--help","-h"])) stop usage + end block print_usage_if_help_requested + + call system_clock(t_start, clock_rate) + call netCDF_file_test%report(passes, tests) + call system_clock(t_finish) print * - print *,"Test suite execution time: ",t_finish - t_start + print *,"Test suite execution time: ", real(t_finish - t_start, real64)/real(clock_rate, real64) print * print '(*(a,:,g0))',"_________ In total, ",passes," of ",tests, " tests pass. _________" #if defined(MULTI_IMAGE_SUPPORT) diff --git a/demo/test/netCDF_file_test_m.F90 b/demo/test/netCDF_file_test_m.F90 index db6555f80..9eddc1655 100644 --- a/demo/test/netCDF_file_test_m.F90 +++ b/demo/test/netCDF_file_test_m.F90 @@ -8,7 +8,7 @@ module NetCDF_file_test_m ! External dependencies use assert_m - use julienne_m, only : string_t, test_t, test_result_t + use julienne_m, only : test_t, test_result_t, test_description_t, test_description_substring, string_t use netcdf, only : & nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions nf90_close, nf90_open, nf90_inq_varid, nf90_get_var, nf90_inquire_variable, & @@ -41,24 +41,22 @@ pure function subject() result(specimen) function results() result(test_results) type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) character(len=*), parameter :: longest_description = & "writing and then reading gives input matching the output for a 1D double precision array" + test_descriptions = & + [ test_description_t("writing and then reading gives input matching the output for a 2D integer array", write_then_read_2D_integer), & + test_description_t("writing and then reading gives input matching the output for a 1D double precision array", write_then_read_1D_double) & + ] associate( & - descriptions => & - [ character(len=len(longest_description)) :: & - "writing and then reading gives input matching the output for a 2D integer array", & - "writing and then reading gives input matching the output for a 1D double precision array" & - ], & - outcomes => & - [ write_then_read_2D_integer(), & - write_then_read_1D_double() & - ] & + substring_in_subject => index(subject(), test_description_substring) /= 0, & + substring_in_description => test_descriptions%contains_text(string_t(test_description_substring)) & ) - call_assert(size(descriptions) == size(outcomes)) - test_results = test_result_t(descriptions, outcomes) + test_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_description) end associate + test_results = test_descriptions%run() end function @@ -118,7 +116,7 @@ subroutine output_1D_double(file_name, data_out) end subroutine function write_then_read_2D_integer() result(test_passes) - logical, allocatable :: test_passes(:) + logical test_passes integer i, j integer, parameter :: ny = 12, nx = 6 integer, parameter :: data_written(*,*) = reshape([((i*j, i=1,nx), j=1,ny)], [ny,nx]) @@ -131,12 +129,12 @@ function write_then_read_2D_integer() result(test_passes) call NetCDF_file%input("data", data_read) end associate - test_passes = [all(data_written == data_read)] + test_passes = all(data_written == data_read) end function function write_then_read_1D_double() result(test_passes) - logical, allocatable :: test_passes(:) + logical test_passes integer i integer, parameter :: nx = 6 double precision, parameter :: data_written(*) = dble([(i, i=1,nx)]), tolerance = 1.E-15 @@ -149,7 +147,7 @@ function write_then_read_1D_double() result(test_passes) call NetCDF_file%input("data", data_read) end associate - test_passes = [all(abs(data_written - data_read)