From faebefbc95e2e17afb14900512ae77fd30696b65 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Wed, 12 Feb 2025 20:28:17 -0700 Subject: [PATCH 01/22] feat(demo): add convert-time-data-to-json app --- demo/app/convert-time-data-to-json.f90 | 36 ++++++++++++++++++++++++++ demo/src/time_data_m.F90 | 4 +-- demo/src/time_data_s.F90 | 4 +-- 3 files changed, 40 insertions(+), 4 deletions(-) create mode 100644 demo/app/convert-time-data-to-json.f90 diff --git a/demo/app/convert-time-data-to-json.f90 b/demo/app/convert-time-data-to-json.f90 new file mode 100644 index 000000000..793dce94d --- /dev/null +++ b/demo/app/convert-time-data-to-json.f90 @@ -0,0 +1,36 @@ +! Copyright (c) 2022-2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt +program convert_time_data_to_json + !! Convert icar time-step output file to JSON format + use julienne_m, only : string_t, file_t, command_line_t + use time_data_m, only : time_data_t, icar_output_file_t + implicit none + + character(len=*), parameter :: usage_info = & + new_line('') // & + 'Usage: ./build/run-fpm.sh run convert-time-data-to-json -- --input-file --output-file ' // & + 'where angular brackets (<>) denote user-provided input.' // & + new_line('') + + associate(time_data => time_data_t(icar_output_file_t(file_t(file_path("--input-file"))))) + associate(json_file => time_data%to_json()) + call json_file%write_lines(file_path("--output-file")) + end associate + end associate + + print *,new_line('') // "______ convert-time-data-to-json done _______" + +contains + + function file_path(flag) result(string) + character(len=*), intent(in) :: flag + type(string_t) string + character(len=:), allocatable :: flag_value + type(command_line_t) command_line + + flag_value = command_line%flag_value(flag) + if (len(flag_value)==0) error stop usage_info + string = string_t(flag_value) + end function + +end program diff --git a/demo/src/time_data_m.F90 b/demo/src/time_data_m.F90 index bc5acd068..43aadd7eb 100644 --- a/demo/src/time_data_m.F90 +++ b/demo/src/time_data_m.F90 @@ -57,9 +57,9 @@ pure module function from_icar_output(icar_output_file) result(time_data) interface icar_output_file_t - pure module function from_string_array(lines) result(icar_output_file) + pure module function from_file_object(file) result(icar_output_file) implicit none - type(string_t), intent(in) :: lines(:) + type(file_t), intent(in) :: file type(icar_output_file_t) icar_output_file end function diff --git a/demo/src/time_data_s.F90 b/demo/src/time_data_s.F90 index 127041664..5c78cafe9 100644 --- a/demo/src/time_data_s.F90 +++ b/demo/src/time_data_s.F90 @@ -9,8 +9,8 @@ implicit none contains - module procedure from_string_array - icar_output_file%file_t = file_t(lines) + module procedure from_file_object + icar_output_file%file_t = file end procedure module procedure default_real_from_json From a05781479fed943f4179ebde6ac4d3ea7289301d Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 18 Feb 2025 15:22:01 -0800 Subject: [PATCH 02/22] fix(demo): whitespace edits --- demo/app/convert-time-data-to-json.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/demo/app/convert-time-data-to-json.f90 b/demo/app/convert-time-data-to-json.f90 index 793dce94d..12b32af42 100644 --- a/demo/app/convert-time-data-to-json.f90 +++ b/demo/app/convert-time-data-to-json.f90 @@ -6,12 +6,12 @@ program convert_time_data_to_json use time_data_m, only : time_data_t, icar_output_file_t implicit none - character(len=*), parameter :: usage_info = & + character(len=*), parameter :: usage_info = & new_line('') // & 'Usage: ./build/run-fpm.sh run convert-time-data-to-json -- --input-file --output-file ' // & 'where angular brackets (<>) denote user-provided input.' // & new_line('') - + associate(time_data => time_data_t(icar_output_file_t(file_t(file_path("--input-file"))))) associate(json_file => time_data%to_json()) call json_file%write_lines(file_path("--output-file")) From 9ed8bcfab082e7dd815785c87829310bd85262ea Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 22 Feb 2025 17:40:44 -0800 Subject: [PATCH 03/22] feat(tensor-statistics): variable tensor list This commit updates demo/app/tensor-statistics.F90 to read the model input and output tensor names from training_configuration.json to faciliatate varying the list (e.g., to switch between the simple SB04 microphysics to the production Thompon microphysics). The updates mirror previously-commited changes in demo/app/train-cloud-microphysics.F90. --- demo/app/tensor-statistics.F90 | 226 ++++++++++++--------------------- demo/src/NetCDF_variable_m.f90 | 19 +++ demo/src/NetCDF_variable_s.F90 | 13 ++ 3 files changed, 113 insertions(+), 145 deletions(-) diff --git a/demo/app/tensor-statistics.F90 b/demo/app/tensor-statistics.F90 index c00f74c1a..0eb921bfb 100644 --- a/demo/app/tensor-statistics.F90 +++ b/demo/app/tensor-statistics.F90 @@ -3,27 +3,6 @@ #include "assert_macros.h" -module ubounds_m - !! This module serves only to support array bounds checking in the main program below - implicit none - - type ubounds_t - integer, allocatable :: ubounds_(:) - contains - procedure equals - generic :: operator(==) => equals - end type - -contains - - elemental function equals(lhs, rhs) result(lhs_equals_rhs) - class(ubounds_t), intent(in) :: lhs, rhs - logical lhs_equals_rhs - lhs_equals_rhs = all(lhs%ubounds_ == rhs%ubounds_) - end function - -end module - program tensor_statistics !! This program !! 1. Computes the ranges and histograms of input and output tensors saved by @@ -33,13 +12,14 @@ program tensor_statistics ! External dependencies: use julienne_m, only : command_line_t, file_t, string_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 NetCDF_variable_m, only: NetCDF_variable_t use histogram_m, only: histogram_t, to_file + use training_configuration_m, only : training_configuration_t implicit none character(len=*), parameter :: usage = new_line('a') // new_line('a') // & @@ -59,7 +39,15 @@ program tensor_statistics call system_clock(t_start, clock_rate) call get_command_line_arguments(base_name, num_bins, start_step, end_step, stride, raw) - call compute_histograms(base_name, raw) + associate(training_configuration => training_configuration_t(file_t("training_configuration.json"))) + call compute_histograms( & + input_tensors_file_name = base_name // "_input.nc" & + ,output_tensors_file_name = base_name // "_output.nc" & + ,raw = raw & + , input_names = training_configuration%input_names() & + ,output_names = training_configuration%output_names() & + ) + end associate call system_clock(t_finish) print *,"System clock time: ", real(t_finish - t_start, real64)/real(clock_rate, real64) @@ -119,133 +107,46 @@ subroutine get_command_line_arguments(base_name, num_bins, start_step, end_step, end subroutine get_command_line_arguments - subroutine compute_histograms(base_name, raw) - character(len=*), intent(in) :: base_name + subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, raw, input_names, output_names) + character(len=*), intent(in) :: input_tensors_file_name, output_tensors_file_name logical, intent(in) :: raw - integer(int64) t_histo_start, t_histo_finish + type(string_t), intent(in) :: input_names(:), output_names(:) - real, allocatable, dimension(:,:,:,:) :: & - pressure_in , potential_temperature_in , temperature_in , & - pressure_out, potential_temperature_out, temperature_out, & - qv_out, qc_out, qr_out, qs_out, & - qv_in , qc_in , qr_in , qs_in , & - dpt_dt, dqv_dt, dqc_dt, dqr_dt, dqs_dt + type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:), derivative(:) + type(NetCDF_variable_t) input_time, output_time double precision, allocatable, dimension(:) :: time_in, time_out double precision, parameter :: tolerance = 1.E-07 - type(histogram_t), allocatable :: histograms(:) - type(ubounds_t), allocatable :: ubounds(:) - integer, allocatable :: lbounds(:) - integer t, t_end - - associate( network_input_file_name => base_name // "_input.nc") - - print *,"Reading network inputs from " // network_input_file_name - - associate(network_input_file => netCDF_file_t(network_input_file_name)) - ! Skipping the following unnecessary inputs: precipitation, snowfall - call network_input_file%input("pressure", pressure_in) - call network_input_file%input("potential_temperature", potential_temperature_in) - call network_input_file%input("temperature", temperature_in) - call network_input_file%input("qv", qv_in) - call network_input_file%input("qc", qc_in) - call network_input_file%input("qr", qr_in) - call network_input_file%input("qs", qs_in) - call network_input_file%input("time", time_in) - - t_end = size(time_in) - lbounds = [lbound(pressure_in), lbound(temperature_in), lbound(qv_in), lbound(qc_in), lbound(qr_in), lbound(qs_in)] - ubounds = & - [ubounds_t(ubound(qv_in)), ubounds_t(ubound(qc_in)), ubounds_t(ubound(qr_in)), ubounds_t(ubound(qs_in)), & - ubounds_t(ubound(pressure_in)), ubounds_t(ubound(temperature_in)) & - ] - - print *,"Calculating input tensor histograms." - call system_clock(t_histo_start) - histograms = [ & - histogram_t(pressure_in, "pressure", num_bins, raw) & - ,histogram_t(potential_temperature_in, 'potential-temperature', num_bins, raw) & - ,histogram_t(temperature_in, "temperature", num_bins, raw) & - ,histogram_t(qv_in, "qv", num_bins, raw) & - ,histogram_t(qc_in, "qc", num_bins, raw) & - ,histogram_t(qr_in, "qr", num_bins, raw) & - ,histogram_t(qs_in, "qs", num_bins, raw) & - ] - call system_clock(t_histo_finish) - print *,"Seven input histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." - - print *,"Writing input tensor histograms file" - block - type(file_t) histograms_file - integer h - - if (raw) then - do h = 1, size(histograms) - histograms_file = to_file(histograms(h)) - call histograms_file%write_lines(string_t(histograms(h)%variable_name() // ".plt")) - end do - else - histograms_file = to_file(histograms) - call histograms_file%write_lines(string_t(base_name // "_inputs_stats.plt")) - end if - end block - end associate - end associate + integer(int64) t_histo_start, t_histo_finish + integer t, t_end, v - associate(network_output_file_name => base_name // "_output.nc") - - print *, "Reading network outputs from " // network_output_file_name - - associate(network_output_file => netCDF_file_t(network_output_file_name)) - ! Skipping the following unnecessary outputs: pressure, temperature, precipitation, snowfall - call network_output_file%input("potential_temperature", potential_temperature_out) - call network_output_file%input("qv", qv_out) - call network_output_file%input("qc", qc_out) - call network_output_file%input("qr", qr_out) - call network_output_file%input("qs", qs_out) - call network_output_file%input("time", time_out) - 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_diagnose(all(lbounds == 1), "main: default input/output lower bounds", intrinsic_array_t(lbounds)) - call_assert_describe(all(ubounds == ubounds(1)), "main: matching input/output upper bounds") - call_assert_describe(all(abs(time_in(2:t_end) - time_out(1:t_end-1)) real(time_out - time_in)) - do concurrent(t = 1:t_end) - dpt_dt(:,:,:,t) = (potential_temperature_out(:,:,:,t) - potential_temperature_in(:,:,:,t))/dt(t) - dqv_dt(:,:,:,t) = (qv_out(:,:,:,t)- qv_in(:,:,:,t))/dt(t) - dqc_dt(:,:,:,t) = (qc_out(:,:,:,t)- qc_in(:,:,:,t))/dt(t) - dqr_dt(:,:,:,t) = (qr_out(:,:,:,t)- qr_in(:,:,:,t))/dt(t) - dqs_dt(:,:,:,t) = (qs_out(:,:,:,t)- qs_in(:,:,:,t))/dt(t) - end do - end associate - - call_assert(.not. any(ieee_is_nan(dpt_dt))) - call_assert(.not. any(ieee_is_nan(dqv_dt))) - call_assert(.not. any(ieee_is_nan(dqc_dt))) - call_assert(.not. any(ieee_is_nan(dqr_dt))) - call_assert(.not. any(ieee_is_nan(dqs_dt))) - - print *,"Calculating output tensor histograms." - call system_clock(t_histo_start, clock_rate) - histograms = [ & - histogram_t(dpt_dt, "dptdt", num_bins, raw) & - ,histogram_t(dqv_dt, "dqvdt", num_bins, raw) & - ,histogram_t(dqc_dt, "dqcdt", num_bins, raw) & - ,histogram_t(dqr_dt, "dqrdt", num_bins, raw) & - ,histogram_t(dqs_dt, "dqsdt", num_bins, raw) & - ] + allocate(input_variable(size(input_names))) + + print *,"Reading physics-based model inputs from " // input_tensors_file_name + + input_file: & + associate(NetCDF_file => netCDF_file_t(input_tensors_file_name)) + + do v=1, size(input_variable) + print *,"- reading ", input_names(v)%string() + call input_variable(v)%input(input_names(v), NetCDF_file, rank=4) + end do + + do v = 2, size(input_variable) + call_assert(input_variable(v)%conformable_with(input_variable(1))) + end do + + print *,"- reading time" + call input_time%input("time", NetCDF_file, rank=1) + + end associate input_file + + print *,"Calculating input tensor histograms." + call system_clock(t_histo_start) + associate(histograms => [(input_variable(v)%histogram(num_bins, raw), v = 1, size(input_variable))]) call system_clock(t_histo_finish) - print *,"Five output histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." + print *,size(histograms), " input histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." + + print *,"Writing input tensor histograms file" block type(file_t) histograms_file integer h @@ -257,10 +158,45 @@ subroutine compute_histograms(base_name, raw) end do else histograms_file = to_file(histograms) - call histograms_file%write_lines(string_t(base_name // "_outputs_stats.plt")) + call histograms_file%write_lines(string_t(base_name // "_inputs_stats.plt")) end if end block end associate + + ! print *,"Calculating time derivatives" + + ! allocate(dpt_dt, mold = potential_temperature_out) + ! allocate(dqv_dt, mold = qv_out) + ! allocate(dqc_dt, mold = qc_out) + ! allocate(dqr_dt, mold = qr_out) + ! allocate(dqs_dt, mold = qs_out) + + ! associate(dt => real(time_out - time_in)) + ! do concurrent(t = 1:t_end) + ! dpt_dt(:,:,:,t) = (potential_temperature_out(:,:,:,t) - potential_temperature_in(:,:,:,t))/dt(t) + ! dqv_dt(:,:,:,t) = (qv_out(:,:,:,t)- qv_in(:,:,:,t))/dt(t) + ! dqc_dt(:,:,:,t) = (qc_out(:,:,:,t)- qc_in(:,:,:,t))/dt(t) + ! dqr_dt(:,:,:,t) = (qr_out(:,:,:,t)- qr_in(:,:,:,t))/dt(t) + ! dqs_dt(:,:,:,t) = (qs_out(:,:,:,t)- qs_in(:,:,:,t))/dt(t) + ! end do + ! end associate + + ! call_assert(.not. any(ieee_is_nan(dpt_dt))) + ! call_assert(.not. any(ieee_is_nan(dqv_dt))) + ! call_assert(.not. any(ieee_is_nan(dqc_dt))) + ! call_assert(.not. any(ieee_is_nan(dqr_dt))) + ! call_assert(.not. any(ieee_is_nan(dqs_dt))) + + ! print *,"Calculating output tensor histograms." + ! histograms = [ & + ! histogram_t(dpt_dt, "dptdt", num_bins, raw) & + ! ,histogram_t(dqv_dt, "dqvdt", num_bins, raw) & + ! ,histogram_t(dqc_dt, "dqcdt", num_bins, raw) & + ! ,histogram_t(dqr_dt, "dqrdt", num_bins, raw) & + ! ,histogram_t(dqs_dt, "dqsdt", num_bins, raw) & + ! ] + ! call system_clock(t_histo_finish) + end subroutine end program tensor_statistics diff --git a/demo/src/NetCDF_variable_m.f90 b/demo/src/NetCDF_variable_m.f90 index 113145236..fd870e52a 100644 --- a/demo/src/NetCDF_variable_m.f90 +++ b/demo/src/NetCDF_variable_m.f90 @@ -3,6 +3,7 @@ module NetCDF_variable_m use NetCDF_file_m, only : NetCDF_file_t use kind_parameters_m, only : default_real, double_precision + use histogram_m, only : histogram_t use julienne_m, only : string_t use fiats_m, only : tensor_t implicit none @@ -37,6 +38,8 @@ module NetCDF_variable_m procedure, private, non_overridable :: default_real_divide , double_precision_divide generic :: assignment(=) => default_real_assign , double_precision_assign procedure, private, non_overridable :: default_real_assign , double_precision_assign + generic :: histogram => default_real_histogram , double_precision_histogram + procedure, private, non_overridable :: default_real_histogram , double_precision_histogram end type interface NetCDF_variable_t @@ -232,6 +235,22 @@ elemental module function double_precision_end_time(self) result(end_time) integer end_time end function + elemental module function default_real_histogram(self, num_bins, raw) result(histogram) + implicit none + class(NetCDF_variable_t), intent(inout) :: self + integer, intent(in) :: num_bins + logical, intent(in) :: raw + type(histogram_t) histogram + end function + + elemental module function double_precision_histogram(self, num_bins, raw) result(histogram) + implicit none + class(NetCDF_variable_t(double_precision)), intent(inout) :: self + integer, intent(in) :: num_bins + logical, intent(in) :: raw + type(histogram_t) histogram + end function + end interface end module \ No newline at end of file diff --git a/demo/src/NetCDF_variable_s.F90 b/demo/src/NetCDF_variable_s.F90 index c2a3d5c68..218df8e6e 100644 --- a/demo/src/NetCDF_variable_s.F90 +++ b/demo/src/NetCDF_variable_s.F90 @@ -27,6 +27,19 @@ contains + module procedure default_real_histogram + select case(self%rank()) + case (4) + histogram = histogram_t(self%values_4D_ , self%name_, num_bins, raw) + case default + error stop 'NetCDF_variable_s(default_real_histogram): unsupported rank' + end select + end procedure + + module procedure double_precision_histogram + error stop 'NetCDF_variable_s(double_precision_histogram): unsupported rank' + end procedure + module procedure default_real_copy if (present(rename)) then From fc7b41ae39262be989e2b457fee98fbad7669adb Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 22 Feb 2025 17:44:42 -0800 Subject: [PATCH 04/22] fix(assertions): update to Assert 2.1.0 This update eliminates a name clash caused by other recent versions of the Assert utility. --- fpm.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fpm.toml b/fpm.toml index 0f4888a70..c809d80c1 100644 --- a/fpm.toml +++ b/fpm.toml @@ -5,5 +5,5 @@ author = "Damian Rouson, Tan Nguyen, Jordan Welsman, David Torres, Brad Richards maintainer = "rouson@lbl.gov" [dependencies] -assert = {git = "https://github.com/sourceryinstitute/assert", tag = "2.0.0"} +assert = {git = "https://github.com/sourceryinstitute/assert", tag = "2.1.0"} julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.5.3"} From 8a4203758856f26115e42c8ade83cdae4a2e2f4b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 23 Feb 2025 16:18:53 -0800 Subject: [PATCH 05/22] fix(histogram_t):always define frequency component This commit fixes an issue that was most likely introduced when the bin-filling algorithm was bifurcated into one version below a performance threshold of 80 bins and another version at or above the threshold. The histogram_t bin_frequency_ component was being defined only above the threshold. This commit defines the component outside (after) the performance-threshold conditional branching so the definition happens regardless of which branch executes. --- demo/src/histogram_s.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/src/histogram_s.F90 b/demo/src/histogram_s.F90 index 59d18af17..360d91117 100644 --- a/demo/src/histogram_s.F90 +++ b/demo/src/histogram_s.F90 @@ -145,8 +145,8 @@ pure function normalize(x, x_min, x_max) result(x_normalized) end do end do end do - histogram%bin_frequency_ = real(bin_count) / real(cardinality) end if + histogram%bin_frequency_ = real(bin_count) / real(cardinality) end associate end associate end associate From 5ea177da772844015fa5251c97b5f5541229420b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 23 Feb 2025 16:47:43 -0800 Subject: [PATCH 06/22] fix(demo/app): update gnuplot script nomenclature This commit switches the variable name "potential-temperature" to "potential_temperature" in the plot-raw-histograms gnuplot script to match a recent change in the gnuplot file. --- demo/app/plot-raw-histograms.gnu | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/demo/app/plot-raw-histograms.gnu b/demo/app/plot-raw-histograms.gnu index f009b79dc..4dffc38b7 100644 --- a/demo/app/plot-raw-histograms.gnu +++ b/demo/app/plot-raw-histograms.gnu @@ -3,7 +3,7 @@ set term png size 2600, 1200 set output "input-tensor-histograms.png" set multiplot layout 3,3 -do for [name in "potential-temperature pressure qc qr qs qv temperature"] { +do for [name in "potential_temperature pressure qc qr qs qv temperature"] { filename = name . ".plt" set title sprintf("Histogram for %s",name) plot filename using 1:2 with linespoints title columnheader From 340d8815b768004632f7231f225339d4112aad36 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 23 Feb 2025 16:57:41 -0800 Subject: [PATCH 07/22] chore(histogram_s): sum bin values iff ASSERTIONS --- demo/src/histogram_s.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/demo/src/histogram_s.F90 b/demo/src/histogram_s.F90 index 360d91117..4d5ef8c89 100644 --- a/demo/src/histogram_s.F90 +++ b/demo/src/histogram_s.F90 @@ -151,9 +151,11 @@ pure function normalize(x, x_min, x_max) result(x_normalized) end associate end associate end associate +#ifdef ASSERTIONS associate(binned => sum(bin_count)) call_assert_diagnose(cardinality == binned, "histogram_s(construct): lossless binning", intrinsic_array_t([cardinality, binned])) end associate +#endif end associate end procedure From 0fdad591b0289c1191e4214e1d73c445898a9741 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sun, 23 Feb 2025 22:48:57 -0800 Subject: [PATCH 08/22] feat(tensor-statistics): variable tensor reads This commit finishes the process of adjusting the reading of model input tensors and desired model output tensors so that both are specified by and read from the "tensor names" object in the training_configuration.json file. --- demo/app/plot-raw-histograms.gnu | 2 +- demo/app/tensor-statistics.F90 | 143 +++++++++++++++++--------- demo/app/train-cloud-microphysics.F90 | 9 +- demo/fpm.toml | 4 +- demo/src/NetCDF_variable_m.f90 | 45 +++----- demo/src/NetCDF_variable_s.F90 | 123 +++++++--------------- 6 files changed, 156 insertions(+), 170 deletions(-) diff --git a/demo/app/plot-raw-histograms.gnu b/demo/app/plot-raw-histograms.gnu index 4dffc38b7..fe081ff59 100644 --- a/demo/app/plot-raw-histograms.gnu +++ b/demo/app/plot-raw-histograms.gnu @@ -14,7 +14,7 @@ unset multiplot set output "output-tensor-histograms.png" set multiplot layout 3,2 -do for [name in "dptdt dqcdt dqrdt dqsdt dqvdt"] { +do for [name in "dpotential_temperature_dt dqc_dt dqr_dt dqs_dt dqv_dt"] { filename = name . ".plt" set title sprintf("Histogram for %s",name) plot filename using 1:2 with linespoints title columnheader diff --git a/demo/app/tensor-statistics.F90 b/demo/app/tensor-statistics.F90 index 0eb921bfb..214024b10 100644 --- a/demo/app/tensor-statistics.F90 +++ b/demo/app/tensor-statistics.F90 @@ -17,7 +17,7 @@ program tensor_statistics ! Internal dependencies: use NetCDF_file_m, only: NetCDF_file_t - use NetCDF_variable_m, only: NetCDF_variable_t + use NetCDF_variable_m, only: NetCDF_variable_t, time_derivative_t use histogram_m, only: histogram_t, to_file use training_configuration_m, only : training_configuration_t implicit none @@ -50,18 +50,18 @@ program tensor_statistics end associate call system_clock(t_finish) - print *,"System clock time: ", real(t_finish - t_start, real64)/real(clock_rate, real64) + print '(a,g0)',"System clock time: ", real(t_finish - t_start, real64)/real(clock_rate, real64) print * - print *,"______________________________________________________" - print *,"The *.plt files contain tensor ranges and histograms." - print *,"If you have gnuplot installed, please execute the" - print *,"following command to produce histogram visualizations:" + print '(a)',"______________________________________________________" + print '(a)',"The *.plt files contain tensor ranges and histograms." + print '(a)',"If you have gnuplot installed, please execute the" + print '(a)',"following command to produce histogram visualizations:" print * associate(file_name => trim(merge("plot-raw-histograms ", "plot-normalized-histograms", raw)) // ".gnu") print*," gnuplot app/" // file_name end associate print * - print *,"_______________ tensor_statistics done________________" + print '(a)',"_______________ tensor_statistics done________________" contains @@ -112,7 +112,8 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, logical, intent(in) :: raw type(string_t), intent(in) :: input_names(:), output_names(:) - type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:), derivative(:) + type(time_derivative_t), allocatable :: derivative(:) + type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:) type(NetCDF_variable_t) input_time, output_time double precision, allocatable, dimension(:) :: time_in, time_out double precision, parameter :: tolerance = 1.E-07 @@ -121,32 +122,34 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, allocate(input_variable(size(input_names))) - print *,"Reading physics-based model inputs from " // input_tensors_file_name + print '(a)',"Reading physics-based model inputs from " // input_tensors_file_name input_file: & associate(NetCDF_file => netCDF_file_t(input_tensors_file_name)) do v=1, size(input_variable) - print *,"- reading ", input_names(v)%string() + print '(a)',"- reading " // input_names(v)%string() call input_variable(v)%input(input_names(v), NetCDF_file, rank=4) end do +#ifdef ASSERTIONS do v = 2, size(input_variable) call_assert(input_variable(v)%conformable_with(input_variable(1))) end do +#endif - print *,"- reading time" + print '(a)',"- reading time" call input_time%input("time", NetCDF_file, rank=1) end associate input_file - print *,"Calculating input tensor histograms." + print '(a)',"Calculating input tensor histograms." call system_clock(t_histo_start) associate(histograms => [(input_variable(v)%histogram(num_bins, raw), v = 1, size(input_variable))]) call system_clock(t_histo_finish) - print *,size(histograms), " input histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." + print '(i0,a,g0,a)',size(histograms), " input histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." - print *,"Writing input tensor histograms file" + print '(a)',"Writing input tensor histograms file" block type(file_t) histograms_file integer h @@ -154,48 +157,88 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, if (raw) then do h = 1, size(histograms) histograms_file = to_file(histograms(h)) - call histograms_file%write_lines(string_t(histograms(h)%variable_name() // ".plt")) + associate(gnuplot_file_name => histograms(h)%variable_name() // ".plt") + print '(a)',"- writing " // gnuplot_file_name + call histograms_file%write_lines(gnuplot_file_name) + end associate end do else - histograms_file = to_file(histograms) - call histograms_file%write_lines(string_t(base_name // "_inputs_stats.plt")) + histograms_file = to_file(histograms) + associate(gnuplot_file_name => base_name // "_inputs_stats.plt") + print '(a)',"- writing " // gnuplot_file_name + call histograms_file%write_lines(gnuplot_file_name) + end associate end if end block end associate - ! print *,"Calculating time derivatives" - - ! allocate(dpt_dt, mold = potential_temperature_out) - ! allocate(dqv_dt, mold = qv_out) - ! allocate(dqc_dt, mold = qc_out) - ! allocate(dqr_dt, mold = qr_out) - ! allocate(dqs_dt, mold = qs_out) - - ! associate(dt => real(time_out - time_in)) - ! do concurrent(t = 1:t_end) - ! dpt_dt(:,:,:,t) = (potential_temperature_out(:,:,:,t) - potential_temperature_in(:,:,:,t))/dt(t) - ! dqv_dt(:,:,:,t) = (qv_out(:,:,:,t)- qv_in(:,:,:,t))/dt(t) - ! dqc_dt(:,:,:,t) = (qc_out(:,:,:,t)- qc_in(:,:,:,t))/dt(t) - ! dqr_dt(:,:,:,t) = (qr_out(:,:,:,t)- qr_in(:,:,:,t))/dt(t) - ! dqs_dt(:,:,:,t) = (qs_out(:,:,:,t)- qs_in(:,:,:,t))/dt(t) - ! end do - ! end associate - - ! call_assert(.not. any(ieee_is_nan(dpt_dt))) - ! call_assert(.not. any(ieee_is_nan(dqv_dt))) - ! call_assert(.not. any(ieee_is_nan(dqc_dt))) - ! call_assert(.not. any(ieee_is_nan(dqr_dt))) - ! call_assert(.not. any(ieee_is_nan(dqs_dt))) - - ! print *,"Calculating output tensor histograms." - ! histograms = [ & - ! histogram_t(dpt_dt, "dptdt", num_bins, raw) & - ! ,histogram_t(dqv_dt, "dqvdt", num_bins, raw) & - ! ,histogram_t(dqc_dt, "dqcdt", num_bins, raw) & - ! ,histogram_t(dqr_dt, "dqrdt", num_bins, raw) & - ! ,histogram_t(dqs_dt, "dqsdt", num_bins, raw) & - ! ] - ! call system_clock(t_histo_finish) + allocate(output_variable(size(output_names))) + + print '(a)',"Reading physics-based model outputs from " // output_tensors_file_name + + output_file: & + associate(NetCDF_file => netCDF_file_t(output_tensors_file_name)) + + do v=1, size(output_variable) + print '(a)', "- reading " // output_names(v)%string() + call output_variable(v)%input(output_names(v), NetCDF_file, rank=4) + end do + +#ifdef ASSERTIONS + do v = 2, size(output_variable) + call_assert(output_variable(v)%conformable_with(output_variable(1))) + end do +#endif + + print '(a)',"- reading time" + call output_time%input("time", NetCDF_file, rank=1) + + end associate output_file + + print '(a)',"Calculating the desired neural-network model outputs: time derivatives of a subset of the inputs" + + allocate(derivative(size(output_variable))) + + dt: & + associate(dt => NetCDF_variable_t(output_time - input_time, "dt")) + do v = 1, size(derivative) + derivative_name: & + associate(derivative_name => "d" // output_names(v)%string() // "_dt") + print '(a)',"- " // derivative_name + derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=dt) + call_assert(.not. derivative(v)%any_nan()) + end associate derivative_name + end do + end associate dt + + print '(a)',"Calculating histograms for the desired neural-network outputs." + call system_clock(t_histo_start) + associate(histograms => [(derivative(v)%histogram(num_bins, raw), v = 1, size(derivative))]) + call system_clock(t_histo_finish) + print '(i0,a,g0,a)',size(histograms), " output histograms done in ", real(t_histo_finish - t_histo_start, real64)/real(clock_rate, real64), " sec." + + print '(a)',"Writing desired-output tensor histograms file" + block + type(file_t) histograms_file + integer h + + if (raw) then + do h = 1, size(histograms) + histograms_file = to_file(histograms(h)) + associate(gnuplot_file_name => histograms(h)%variable_name() // ".plt") + print '(a)',"- writing " // gnuplot_file_name + call histograms_file%write_lines(gnuplot_file_name) + end associate + end do + else + histograms_file = to_file(histograms) + associate(gnuplot_file_name => base_name // "_outputs_stats.plt") + print '(a)',"- writing " // gnuplot_file_name + call histograms_file%write_lines(gnuplot_file_name) + end associate + end if + end block + end associate end subroutine diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index 5efe5c40c..4b687c35f 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -20,7 +20,7 @@ program train_cloud_microphysics !! Internal dependencies: use phase_space_bin_m, only : phase_space_bin_t use NetCDF_file_m, only: NetCDF_file_t - use NetCDF_variable_m, only: NetCDF_variable_t, tensors + use NetCDF_variable_m, only: NetCDF_variable_t, tensors, time_derivative_t use occupancy_m, only : occupancy_t use default_m, only: default_or_internal_read @@ -154,7 +154,8 @@ subroutine read_train_write(training_configuration, args, plot_file) type(training_configuration_t), intent(in) :: training_configuration type(command_line_arguments_t), intent(in) :: args type(plot_file_t), intent(in), optional :: plot_file - type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:), derivative(:) + type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:) + type(time_derivative_t), allocatable :: derivative(:) type(NetCDF_variable_t) input_time, output_time ! local variables: @@ -229,7 +230,7 @@ subroutine read_train_write(training_configuration, args, plot_file) print *,"Calculating desired neural-network model outputs" - allocate(derivative, mold=output_variable) + allocate(derivative(size(output_variable))) dt: & associate(dt => NetCDF_variable_t(output_time - input_time, "dt")) @@ -237,7 +238,7 @@ subroutine read_train_write(training_configuration, args, plot_file) derivative_name: & associate(derivative_name => "d" // output_names(v)%string() // "/dt") print *,"- " // derivative_name - derivative(v) = NetCDF_variable_t( (input_variable(v) - output_variable(v)) / dt, derivative_name) + derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=dt) call_assert(.not. derivative(v)%any_nan()) end associate derivative_name end do diff --git a/demo/fpm.toml b/demo/fpm.toml index bde6b9b7b..503877403 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 = "2.0.0"} -julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.8.0"} +assert = {git = "https://github.com/sourceryinstitute/assert", tag = "2.1.0"} +julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.8.4"} fiats = {path = "../"} netcdf-interfaces = {git = "https://github.com/LKedward/netcdf-interfaces.git", rev = "d2bbb71ac52b4e346b62572b1ca1620134481096"} diff --git a/demo/src/NetCDF_variable_m.f90 b/demo/src/NetCDF_variable_m.f90 index fd870e52a..9b67d8a78 100644 --- a/demo/src/NetCDF_variable_m.f90 +++ b/demo/src/NetCDF_variable_m.f90 @@ -11,6 +11,7 @@ module NetCDF_variable_m private public :: NetCDF_variable_t public :: tensors + public :: time_derivative_t type NetCDF_variable_t(k) integer, kind :: k = default_real @@ -34,14 +35,24 @@ module NetCDF_variable_m procedure, private, non_overridable :: default_real_maximum , double_precision_maximum generic :: operator(-) => default_real_subtract , double_precision_subtract procedure, private, non_overridable :: default_real_subtract , double_precision_subtract - generic :: operator(/) => default_real_divide , double_precision_divide - procedure, private, non_overridable :: default_real_divide , double_precision_divide - generic :: assignment(=) => default_real_assign , double_precision_assign - procedure, private, non_overridable :: default_real_assign , double_precision_assign generic :: histogram => default_real_histogram , double_precision_histogram procedure, private, non_overridable :: default_real_histogram , double_precision_histogram end type + type, extends(NetCDF_variable_t) :: time_derivative_t(k) + integer, kind :: k = default_real + end type + + interface time_derivative_t + + impure elemental module function default_real_time_derivative(old, new, dt) result(time_derivative) + implicit none + type(NetCDF_variable_t), intent(in) :: old, new, dt + type(time_derivative_t) time_derivative + end function + + end interface + interface NetCDF_variable_t elemental module function default_real_copy(source, rename) result(NetCDF_variable) @@ -156,30 +167,6 @@ elemental module function double_precision_subtract(lhs, rhs) result(difference) type(NetCDF_variable_t(double_precision)) difference end function - elemental module function default_real_divide(lhs, rhs) result(ratio) - implicit none - class(NetCDF_variable_t), intent(in) :: lhs, rhs - type(NetCDF_variable_t) ratio - end function - - elemental module function double_precision_divide(lhs, rhs) result(ratio) - implicit none - class(NetCDF_variable_t(double_precision)), intent(in) :: lhs, rhs - type(NetCDF_variable_t(double_precision)) ratio - end function - - elemental module subroutine default_real_assign(lhs, rhs) - implicit none - class(NetCDF_variable_t), intent(inout) :: lhs - type(NetCDF_variable_t), intent(in) :: rhs - end subroutine - - elemental module subroutine double_precision_assign(lhs, rhs) - implicit none - class(NetCDF_variable_t(double_precision)), intent(inout) :: lhs - type(NetCDF_variable_t(double_precision)), intent(in) :: rhs - end subroutine - elemental module function default_real_any_nan(self) result(any_nan) implicit none class(NetCDF_variable_t), intent(in) :: self @@ -218,7 +205,7 @@ elemental module function double_precision_maximum(self) result(maximum) module function tensors(NetCDF_variables, step_start, step_end, step_stride) implicit none - type(NetCDF_variable_t), intent(in) :: NetCDF_variables(:) + class(NetCDF_variable_t), intent(in) :: NetCDF_variables(:) type(tensor_t), allocatable :: tensors(:) integer, optional :: step_start, step_end, step_stride end function diff --git a/demo/src/NetCDF_variable_s.F90 b/demo/src/NetCDF_variable_s.F90 index 218df8e6e..00c39b5d8 100644 --- a/demo/src/NetCDF_variable_s.F90 +++ b/demo/src/NetCDF_variable_s.F90 @@ -27,6 +27,45 @@ contains + module procedure default_real_time_derivative + + call_assert(dt%rank()==1) + call_assert(new%conformable_with(old)) + call_assert(old%name_==new%name_) + + time_derivative%name_ = "d" // old%name_ // "_dt" + + block + integer t + + select case(old%rank()) + case(1) + allocate(time_derivative%values_1D_, mold = old%values_1D_) + do concurrent(t = 1:size(old%values_1D_)) + time_derivative%values_1D_(t) = (new%values_1D_(t) - old%values_1D_(t))/ dt%values_1D_(t) + end do + case(2) + allocate(time_derivative%values_2D_, mold = old%values_2D_) + do concurrent(t = 1:size(old%values_2D_,2)) + time_derivative%values_2D_(:,t) = (new%values_2D_(:,t) - old%values_2D_(:,t))/ dt%values_1D_(t) + end do + case(3) + allocate(time_derivative%values_3D_, mold = old%values_3D_) + do concurrent(t = 1:size(old%values_3D_,3)) + time_derivative%values_3D_(:,:,t) = (new%values_3D_(:,:,t) - old%values_3D_(:,:,t))/ dt%values_1D_(t) + end do + case(4) + allocate(time_derivative%values_4D_, mold = old%values_4D_) + do concurrent(t = 1:size(old%values_4D_,4)) + time_derivative%values_4D_(:,:,:,t) = (new%values_4D_(:,:,:,t) - old%values_4D_(:,:,:,t))/ dt%values_1D_(t) + end do + case default + error stop "NetCDF_variable_s(default_real_time_derivative): unsupported rank)" + end select + end block + + end procedure + module procedure default_real_histogram select case(self%rank()) case (4) @@ -318,90 +357,6 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) end select end procedure - module procedure default_real_divide - - integer t - - call_assert(rhs%rank()==1) - - associate(t_end => size(rhs%values_1D_)) - - select case(lhs%rank()) - case(4) - - 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) - ratio%values_4D_(:,:,:,t) = lhs%values_4D_(:,:,:,t) / rhs%values_1D_(t) - end do - - case default - error stop "NetCDF_variable_s(default_real_divide): unsupported lhs rank)" - end select - - end associate - - end procedure - - module procedure double_precision_divide - - integer t - - call_assert(rhs%rank()==1) - - associate(t_end => size(rhs%values_1D_)) - - select case(lhs%rank()) - case(4) - - 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) - ratio%values_4D_(:,:,:,t) = lhs%values_4D_(:,:,:,t) / rhs%values_1D_(t) - end do - - case default - error stop "NetCDF_variable_s(double_precision_divide): unsupported lhs rank)" - end select - - end associate - - end procedure - - module procedure default_real_assign - select case(rhs%rank()) - case(1) - lhs%values_1D_ = rhs%values_1D_ - case(2) - lhs%values_2D_ = rhs%values_2D_ - case(3) - lhs%values_3D_ = rhs%values_3D_ - case(4) - lhs%values_4D_ = rhs%values_4D_ - case default - error stop "NetCDF_variable_s(default_real_assign): unsupported rank)" - end select - call_assert(lhs%rank()==rhs%rank()) - end procedure - - module procedure double_precision_assign - select case(rhs%rank()) - case(1) - lhs%values_1D_ = rhs%values_1D_ - case(2) - lhs%values_2D_ = rhs%values_2D_ - case(3) - lhs%values_3D_ = rhs%values_3D_ - case(4) - lhs%values_4D_ = rhs%values_4D_ - case default - error stop "NetCDF_variable_s(double_precision_assign): unsupported rank)" - end select - call_assert(lhs%rank()==rhs%rank()) - end procedure - module procedure default_real_any_nan select case(self%rank()) From 92fda06d0682c9a35531735b822430327c1a86e7 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 7 Apr 2025 09:03:49 -0600 Subject: [PATCH 09/22] feat(icar_output_file): add from_lines constructor --- demo/src/time_data_m.F90 | 6 ++++++ demo/src/time_data_s.F90 | 4 ++++ demo/test/time_data_test_m.F90 | 8 ++++---- 3 files changed, 14 insertions(+), 4 deletions(-) diff --git a/demo/src/time_data_m.F90 b/demo/src/time_data_m.F90 index 43aadd7eb..834bc80bb 100644 --- a/demo/src/time_data_m.F90 +++ b/demo/src/time_data_m.F90 @@ -63,6 +63,12 @@ pure module function from_file_object(file) result(icar_output_file) type(icar_output_file_t) icar_output_file end function + pure module function from_lines(lines) result(icar_output_file) + implicit none + type(string_t), intent(in) :: lines(:) + type(icar_output_file_t) icar_output_file + end function + end interface interface diff --git a/demo/src/time_data_s.F90 b/demo/src/time_data_s.F90 index 5c78cafe9..6438ba1cd 100644 --- a/demo/src/time_data_s.F90 +++ b/demo/src/time_data_s.F90 @@ -13,6 +13,10 @@ icar_output_file%file_t = file end procedure + module procedure from_lines + icar_output_file%file_t = file_t(lines) + end procedure + module procedure default_real_from_json integer i diff --git a/demo/test/time_data_test_m.F90 b/demo/test/time_data_test_m.F90 index 39b78fba9..122378bd7 100644 --- a/demo/test/time_data_test_m.F90 +++ b/demo/test/time_data_test_m.F90 @@ -42,7 +42,7 @@ function results() result(test_results) #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY test_descriptions = [ & - test_description_t("constructing a instance from a file object in the icar output format", construct_from_icar_file) & + test_description_t("constructing a instance from lines in the icar output format", construct_from_icar_file) & test_description_t("writing and reading a JSON file returns the values written", write_then_read_json) & ] #else @@ -71,9 +71,9 @@ function construct_from_icar_file() result(test_diagnosis) real, allocatable :: dt(:) associate(time_data => time_data_t( icar_output_file_t( string_t( [ & - "training data dt= 2010/10/01 03:16:00 120.000000 " & - ,"training data dt= 2010/10/01 06:36:00 120.000000 " & - ,"training data dt= 2010/10/01 09:56:00 120.000000 " & + "training data dt= 2010/10/01 03:16:00 120.000000 1" & + ,"training data dt= 2010/10/01 06:36:00 120.000000 2" & + ,"training data dt= 2010/10/01 09:56:00 120.000000 3" & ] ) ) ) ) associate(dt => time_data%dt()) test_diagnosis = test_diagnosis_t( & From aab11f02c471649d2d84f5f8fc5b5fd818535e3a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 7 Apr 2025 15:54:27 -0600 Subject: [PATCH 10/22] fix(convert-time-data): improve usage info output --- demo/app/convert-time-data-to-json.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/demo/app/convert-time-data-to-json.f90 b/demo/app/convert-time-data-to-json.f90 index 12b32af42..c8bcfcf04 100644 --- a/demo/app/convert-time-data-to-json.f90 +++ b/demo/app/convert-time-data-to-json.f90 @@ -7,8 +7,8 @@ program convert_time_data_to_json implicit none character(len=*), parameter :: usage_info = & - new_line('') // & - 'Usage: ./build/run-fpm.sh run convert-time-data-to-json -- --input-file --output-file ' // & + new_line('') // new_line('') // & + 'Usage: ./build/run-fpm.sh run convert-time-data-to-json -- --input-file --output-file ' // new_line('') // & 'where angular brackets (<>) denote user-provided input.' // & new_line('') From 7a573370587139065cbaa16c798980219622f847 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 7 Apr 2025 22:58:20 -0600 Subject: [PATCH 11/22] feat: add training data file name abstraction This commit 1. Supports constructing an array of file names for tensor inputs and a corresponding array of file names for tensor outputs. 2. Adds a "training data file names" object to the "training_configuration.json" file and a corresponding derived derived type. --- demo/training_configuration.json | 6 ++ include/language-support.F90 | 11 ++++ src/fiats/training_data_file_names_m.f90 | 67 +++++++++++++++++++++ src/fiats/training_data_file_names_s.F90 | 77 ++++++++++++++++++++++++ src/fiats_m.f90 | 1 + test/main.F90 | 3 + test/training_data_file_names_test_m.F90 | 73 ++++++++++++++++++++++ 7 files changed, 238 insertions(+) create mode 100644 src/fiats/training_data_file_names_m.f90 create mode 100644 src/fiats/training_data_file_names_s.F90 create mode 100644 test/training_data_file_names_test_m.F90 diff --git a/demo/training_configuration.json b/demo/training_configuration.json index a01576ee5..d47f658d6 100644 --- a/demo/training_configuration.json +++ b/demo/training_configuration.json @@ -14,5 +14,11 @@ "tensor names": { "inputs" : ["potential_temperature","qv", "qc", "qr", "qs", "pressure", "temperature"], "outputs" : ["potential_temperature","qv", "qc", "qr", "qs"] + }, + "training data file names": { + "path" : "dates-20101001-2011076", + "inputs prefix" : "training_input-image-", + "outputs prefix" : "training_output-image-", + "infixes" : ["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"] } } diff --git a/include/language-support.F90 b/include/language-support.F90 index d64f0096f..6d9d19ec7 100644 --- a/include/language-support.F90 +++ b/include/language-support.F90 @@ -18,3 +18,14 @@ # define MULTI_IMAGE_SUPPORT 1 #endif #endif + +#ifndef HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + ! Define whether the compiler supports associating a procedure pointer dummy argument with an + ! actual argument that is a valid target for the pointer dummy in a procedure assignment, a + ! feature introduced in Fortran 2008 and described in Fortran 2023 clause 15.5.2.10 paragraph 5. +#if defined(_CRAYFTN) || defined(__INTEL_COMPILER) || defined(NAGFOR) || defined(__flang__) +#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 1 +#else +#define HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY 0 +#endif +#endif diff --git a/src/fiats/training_data_file_names_m.f90 b/src/fiats/training_data_file_names_m.f90 new file mode 100644 index 000000000..b37a093d1 --- /dev/null +++ b/src/fiats/training_data_file_names_m.f90 @@ -0,0 +1,67 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module training_data_file_names_m + use julienne_string_m, only : string_t + implicit none + + private + public :: training_data_file_names_t + + type training_data_file_names_t + private + character(len=:), allocatable :: path_, inputs_prefix_, outputs_prefix_ + type(string_t), allocatable :: infixes_(:) + contains + procedure :: to_json + procedure :: fully_qualified_inputs_files + procedure :: fully_qualified_outputs_files + generic :: operator(==) => equals + procedure, private :: equals + end type + + interface training_data_file_names_t + + module function from_json(lines) result(training_data_file_names) + implicit none + class(string_t), intent(in) :: lines(:) + type(training_data_file_names_t) training_data_file_names + end function + + pure module function from_components(path, inputs_prefix, outputs_prefix, infixes) result(training_data_file_names) + implicit none + character(len=*), intent(in) :: path, inputs_prefix, outputs_prefix + type(string_t), intent(in) :: infixes(:) + type(training_data_file_names_t) training_data_file_names + end function + + end interface + + interface + + elemental module function equals(lhs, rhs) result(lhs_eq_rhs) + implicit none + class(training_data_file_names_t), intent(in) :: lhs, rhs + logical lhs_eq_rhs + end function + + pure module function to_json(self) result(lines) + implicit none + class(training_data_file_names_t), intent(in) :: self + type(string_t), allocatable :: lines(:) + end function + + pure module function fully_qualified_inputs_files(self) result(names) + implicit none + class(training_data_file_names_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function fully_qualified_outputs_files(self) result(names) + implicit none + class(training_data_file_names_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + end interface + +end module diff --git a/src/fiats/training_data_file_names_s.F90 b/src/fiats/training_data_file_names_s.F90 new file mode 100644 index 000000000..1a9d97c93 --- /dev/null +++ b/src/fiats/training_data_file_names_s.F90 @@ -0,0 +1,77 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + +submodule(training_data_file_names_m) training_data_file_names_s + use assert_m + use julienne_m, only : operator(.csv.) + implicit none + + character(len=*), parameter :: training_data_file_names_key = "training data file names" + character(len=*), parameter :: path_key = "path" + character(len=*), parameter :: inputs_prefix_key = "inputs prefix" + character(len=*), parameter :: outputs_prefix_key = "outputs prefix" + character(len=*), parameter :: infixes_key = "infixes" + character(len=*), parameter :: suffix = ".nc" + +contains + + module procedure to_json + character(len=*), parameter :: indent = repeat(" ",ncopies=4) + + lines = [ & + string_t(indent // '"' //training_data_file_names_key // '": {' ) & + ,string_t(indent // indent // '"' // path_key // '" : "' // self%path_ // '",') & + ,string_t(indent // indent // '"' // inputs_prefix_key // '" : "' // self%inputs_prefix_ // '",') & + ,string_t(indent // indent // '"' // outputs_prefix_key // '" : "' // self%outputs_prefix_ // '",') & + , indent // indent // '"infixes" : [' // .csv. self%infixes_%bracket('"') // '],' & + ,string_t(indent // '}' ) & + ] + end procedure + + module procedure from_json + integer l + logical training_data_file_names_key_found + + training_data_file_names_key_found = .false. + + do l=1,size(lines) + if (lines(l)%get_json_key() == training_data_file_names_key) then + training_data_file_names_key_found = .true. + training_data_file_names%path_ = lines(l+1)%get_json_value(string_t(path_key), mold=string_t("")) + training_data_file_names%inputs_prefix_ = lines(l+2)%get_json_value(string_t(inputs_prefix_key), mold=string_t("")) + training_data_file_names%outputs_prefix_ = lines(l+3)%get_json_value(string_t(outputs_prefix_key), mold=string_t("")) + training_data_file_names%infixes_ = lines(l+4)%get_json_value(string_t(infixes_key), mold=[string_t("")]) + return + end if + end do + + call_assert(training_data_file_names_key_found) + end procedure + + module procedure from_components + training_data_file_names%path_ = path + training_data_file_names%inputs_prefix_ = inputs_prefix + training_data_file_names%outputs_prefix_ = outputs_prefix + training_data_file_names%infixes_ = infixes + end procedure + + module procedure equals + lhs_eq_rhs = lhs%path_ == rhs%path_ & + .and. lhs%inputs_prefix_ == rhs%inputs_prefix_ & + .and. lhs%outputs_prefix_ == rhs%outputs_prefix_ & + .and. all(lhs%infixes_ == rhs%infixes_) + end procedure + + module procedure fully_qualified_inputs_files + integer i + names = [(self%path_ // "/" // self%inputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] + end procedure + + module procedure fully_qualified_outputs_files + integer i + names = [(self%path_ // "/" // self%outputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] + end procedure + +end submodule training_data_file_names_s diff --git a/src/fiats_m.f90 b/src/fiats_m.f90 index b8ce8d625..04ca2967b 100644 --- a/src/fiats_m.f90 +++ b/src/fiats_m.f90 @@ -16,5 +16,6 @@ module fiats_m use tensor_names_m, only : tensor_names_t use trainable_network_m, only : trainable_network_t use training_configuration_m, only : training_configuration_t + use training_data_file_names_m, only : training_data_file_names_t implicit none end module fiats_m diff --git a/test/main.F90 b/test/main.F90 index 47e6fd78f..46889303a 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -14,6 +14,7 @@ program main use tensor_map_test_m, only : tensor_map_test_t use tensor_names_test_m, only : tensor_names_test_t use tensor_test_m, only : tensor_test_t + use training_data_file_names_test_m, only : training_data_file_names_test_t use julienne_m, only : command_line_t implicit none @@ -27,6 +28,7 @@ program main type(tensor_map_test_t) tensor_map_test type(tensor_names_test_t) tensor_names_test type(tensor_test_t) tensor_test + type(training_data_file_names_test_t) training_data_file_names_test real t_start, t_finish integer :: passes=0, tests=0 @@ -56,6 +58,7 @@ program main call asymmetric_network_test%report(passes, tests) call neural_network_test%report(passes, tests) call trainable_network_test%report(passes, tests) + call training_data_file_names_test%report(passes, tests) call cpu_time(t_finish) print * diff --git a/test/training_data_file_names_test_m.F90 b/test/training_data_file_names_test_m.F90 new file mode 100644 index 000000000..a40deb902 --- /dev/null +++ b/test/training_data_file_names_test_m.F90 @@ -0,0 +1,73 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module training_data_file_names_test_m + !! Test training_data_file_names_t object I/O and construction + + ! External dependencies + use fiats_m, only : training_data_file_names_t + use julienne_m, only : test_t, test_result_t, test_description_t, test_description_substring, string_t, file_t +#if ! defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) + use julienne_m, only : test_function_i +#endif + + ! Internal dependencies + use training_data_file_names_m, only : training_data_file_names_t + + implicit none + + private + public :: training_data_file_names_test_t + + type, extends(test_t) :: training_data_file_names_test_t + contains + procedure, nopass :: subject + procedure, nopass :: results + end type + +contains + + pure function subject() result(specimen) + character(len=:), allocatable :: specimen + specimen = "A training_data_file_names_t object" + end function + + function results() result(test_results) + type(test_description_t), allocatable :: test_descriptions(:) + type(test_result_t), allocatable :: test_results(:) + +#if defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) + test_descriptions = [ & + test_description_t( string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip) & + ] +#else + procedure(test_function_i), pointer :: check_json_round_trip_ptr + check_json_round_trip_ptr => check_json_round_trip + + test_descriptions = [ & + test_description_t(string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip_ptr) & + ] +#endif + associate( & + substring_in_subject => index(subject(), test_description_substring) /= 0, & + substring_in_description => test_descriptions%contains_text(string_t(test_description_substring)) & + ) + test_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_description) + end associate + test_results = test_descriptions%run() + end function + + function check_json_round_trip() result(test_passes) + logical test_passes + associate(training_data_file_names => training_data_file_names_t( & + path = "dates-20101001-2011076" & + ,inputs_prefix = "training_input-image-" & + ,outputs_prefix = "training_output-image-" & + ,infixes = string_t(["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"]) & + )) + associate(from_json => training_data_file_names_t(training_data_file_names%to_json())) + test_passes = training_data_file_names == from_json + end associate + end associate + end function + +end module training_data_file_names_test_m From d8395d39d64cf6c74afbbcf9aa4a7abf534e5a89 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 7 Apr 2025 23:42:07 -0600 Subject: [PATCH 12/22] feat(training_config): training file name getters --- src/fiats/training_configuration_m.f90 | 31 +++++++++++++++++++++++++- src/fiats/training_configuration_s.F90 | 16 +++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/src/fiats/training_configuration_m.f90 b/src/fiats/training_configuration_m.f90 index 1dd66dbea..1dba883a9 100644 --- a/src/fiats/training_configuration_m.f90 +++ b/src/fiats/training_configuration_m.f90 @@ -9,6 +9,7 @@ module training_configuration_m use kind_parameters_m, only : default_real, double_precision use double_precision_file_m, only : double_precision_file_t use tensor_names_m, only : tensor_names_t + use training_data_file_names_m, only : training_data_file_names_t implicit none private @@ -19,6 +20,7 @@ module training_configuration_m type(hyperparameters_t(m)), private :: hyperparameters_ type(network_configuration_t), private :: network_configuration_ type(tensor_names_t), private :: tensor_names_ + type(training_data_file_names_t), private :: training_data_file_names_ contains generic :: operator(==) => default_real_equals , double_precision_equals procedure, private :: default_real_equals , double_precision_equals @@ -40,8 +42,11 @@ module training_configuration_m procedure, private :: default_real_input_names , double_precision_input_names generic :: output_names => default_real_output_names , double_precision_output_names procedure, private :: default_real_output_names , double_precision_output_names + generic :: input_file_names => default_real_input_file_names, double_precision_input_file_names + procedure, private :: default_real_input_file_names, double_precision_input_file_names + generic :: output_file_names =>default_real_output_file_names, double_precision_output_file_names + procedure, private :: default_real_output_file_names, double_precision_output_file_names end type - interface training_configuration_t module function default_real_from_components(hyperparameters, network_configuration, tensor_names) result(training_configuration) @@ -196,6 +201,30 @@ pure module function double_precision_output_names(self) result(output_names) type(string_t), allocatable :: output_names(:) end function + pure module function default_real_input_file_names(self) result(names) + implicit none + class(training_configuration_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function double_precision_input_file_names(self) result(names) + implicit none + class(training_configuration_t(double_precision)), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function default_real_output_file_names(self) result(names) + implicit none + class(training_configuration_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function double_precision_output_file_names(self) result(names) + implicit none + class(training_configuration_t(double_precision)), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + end interface end module diff --git a/src/fiats/training_configuration_s.F90 b/src/fiats/training_configuration_s.F90 index 9044b93f5..b1e4e1b2b 100644 --- a/src/fiats/training_configuration_s.F90 +++ b/src/fiats/training_configuration_s.F90 @@ -215,4 +215,20 @@ output_names = self%tensor_names_%output_names() end procedure + module procedure default_real_input_file_names + names = self%training_data_file_names_%fully_qualified_inputs_files() + end procedure + + module procedure double_precision_input_file_names + names = self%training_data_file_names_%fully_qualified_inputs_files() + end procedure + + module procedure default_real_output_file_names + names = self%training_data_file_names_%fully_qualified_outputs_files() + end procedure + + module procedure double_precision_output_file_names + names = self%training_data_file_names_%fully_qualified_outputs_files() + end procedure + end submodule training_configuration_s From 6309a152c54599920848cdf962ca2e3860e7b8ae Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 7 Apr 2025 23:43:09 -0600 Subject: [PATCH 13/22] fix(time_data_test): fix typo --- demo/test/time_data_test_m.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/demo/test/time_data_test_m.F90 b/demo/test/time_data_test_m.F90 index 122378bd7..876afad5a 100644 --- a/demo/test/time_data_test_m.F90 +++ b/demo/test/time_data_test_m.F90 @@ -42,8 +42,8 @@ function results() result(test_results) #if HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY test_descriptions = [ & - test_description_t("constructing a instance from lines in the icar output format", construct_from_icar_file) & - test_description_t("writing and reading a JSON file returns the values written", write_then_read_json) & + test_description_t("constructing a instance from a file object in the icar output format", construct_from_icar_file) & + ,test_description_t("writing and reading a JSON file returns the values written", write_then_read_json) & ] #else procedure(diagnosis_function_i), pointer :: construct_from_icar_file_ptr, write_then_read_json_ptr From e1d4a1bb906bddabe18b6f62be67b9e1b5e36b01 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 8 Apr 2025 10:29:38 -0600 Subject: [PATCH 14/22] fix(training_config):differentiate procedure names --- src/fiats/training_configuration_m.f90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fiats/training_configuration_m.f90 b/src/fiats/training_configuration_m.f90 index 1dba883a9..a0c6af235 100644 --- a/src/fiats/training_configuration_m.f90 +++ b/src/fiats/training_configuration_m.f90 @@ -38,14 +38,14 @@ module training_configuration_m procedure, private :: default_real_nodes_per_layer , double_precision_nodes_per_layer generic :: skip_connections => default_real_skip_connections, double_precision_skip_connections procedure, private :: default_real_skip_connections, double_precision_skip_connections - generic :: input_names => default_real_input_names , double_precision_input_names - procedure, private :: default_real_input_names , double_precision_input_names - generic :: output_names => default_real_output_names , double_precision_output_names - procedure, private :: default_real_output_names , double_precision_output_names - generic :: input_file_names => default_real_input_file_names, double_precision_input_file_names - procedure, private :: default_real_input_file_names, double_precision_input_file_names - generic :: output_file_names =>default_real_output_file_names, double_precision_output_file_names - procedure, private :: default_real_output_file_names, double_precision_output_file_names + generic :: input_variable_names => default_real_input_names , double_precision_input_names + procedure, private :: default_real_input_names , double_precision_input_names + generic :: output_variable_names => default_real_output_names , double_precision_output_names + procedure, private :: default_real_output_names , double_precision_output_names + generic :: input_file_names => default_real_input_file_names, double_precision_input_file_names + procedure, private :: default_real_input_file_names, double_precision_input_file_names + generic :: output_file_names => default_real_output_file_names, double_precision_output_file_names + procedure, private :: default_real_output_file_names, double_precision_output_file_names end type interface training_configuration_t From 253d8aae623647c78f65e605a371c6f7b2acce91 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 8 Apr 2025 10:32:02 -0600 Subject: [PATCH 15/22] feat(NetCDF_file): add construct_from_string_name --- demo/src/NetCDF_file_m.f90 | 9 ++++++++- demo/src/NetCDF_file_s.F90 | 6 +++++- 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/demo/src/NetCDF_file_m.f90 b/demo/src/NetCDF_file_m.f90 index 91d1dac92..89bb3c20c 100644 --- a/demo/src/NetCDF_file_m.f90 +++ b/demo/src/NetCDF_file_m.f90 @@ -1,6 +1,7 @@ ! Copyright (c), The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module NetCDF_file_m + use julienne_m, only : string_t implicit none private @@ -16,12 +17,18 @@ module NetCDF_file_m interface NetCDF_file_t - pure module function construct(file_name) result(NetCDF_file) + pure module function construct_from_character_name(file_name) result(NetCDF_file) implicit none character(len=*), intent(in) :: file_name type(NetCDF_file_t) NetCDF_file end function + pure module function construct_from_string_name(file_name) result(NetCDF_file) + implicit none + type(string_t), intent(in) :: file_name + type(NetCDF_file_t) NetCDF_file + end function + end interface interface diff --git a/demo/src/NetCDF_file_s.F90 b/demo/src/NetCDF_file_s.F90 index 7a4bea691..b289c2130 100644 --- a/demo/src/NetCDF_file_s.F90 +++ b/demo/src/NetCDF_file_s.F90 @@ -13,7 +13,11 @@ contains - module procedure construct + module procedure construct_from_string_name + netCDF_file%file_name_ = file_name + end procedure + + module procedure construct_from_character_name netCDF_file%file_name_ = file_name end procedure From f004e3d0dd4ade68f58014cc05eee75206ef089f Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 8 Apr 2025 10:34:39 -0600 Subject: [PATCH 16/22] fix(train-cloud): use new training_conf proc names --- demo/app/train-cloud-microphysics.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index 4b687c35f..f92e4474a 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -170,7 +170,7 @@ subroutine read_train_write(training_configuration, args, plot_file) logical stop_requested input_names: & - associate(input_names => training_configuration%input_names()) + associate(input_names => training_configuration%input_variable_names()) allocate(input_variable(size(input_names))) @@ -199,7 +199,7 @@ subroutine read_train_write(training_configuration, args, plot_file) end associate input_names output_names: & - associate(output_names => training_configuration%output_names()) + associate(output_names => training_configuration%output_variable_names()) allocate(output_variable(size(output_names))) From 640dbeda89eeee12b9e2a4f685c43c2348353145 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 8 Apr 2025 13:41:51 -0600 Subject: [PATCH 17/22] fix(tensor-stats): read training data file names With this commit, ./build/run-fpm.sh run tensor-statistics -- --bins 20 will build up an array of training-data file names from information in a "training data file names" JSON object inside the training_configuration.json file. Currently, the tensor-statistics program reads training data only from the first file in the array, computes corresponding input/ouput tensor component histograms, and writes the histograms toa gnuplot (*.plt) files. Known issue: the plots for the input-tensor component histograms appear to be correct, but the output-tensor component histograms are all zeros. To Do ----- 1. Investigate the reason output-tensor values are all zero. 2. Accumulate tensors across the full suite of training-data files. 3. Fix the time-derivative calculation by incorporating the new time_data_t type into the time derivative calculation. --- demo/app/plot-normalized-histograms.gnu | 4 +- demo/app/tensor-statistics.F90 | 66 +++++++++++------------- src/fiats/training_configuration_m.f90 | 8 ++- src/fiats/training_configuration_s.F90 | 14 ++++- src/fiats/training_data_file_names_s.F90 | 2 +- 5 files changed, 52 insertions(+), 42 deletions(-) diff --git a/demo/app/plot-normalized-histograms.gnu b/demo/app/plot-normalized-histograms.gnu index a8545fa63..47e6107ea 100644 --- a/demo/app/plot-normalized-histograms.gnu +++ b/demo/app/plot-normalized-histograms.gnu @@ -2,10 +2,10 @@ set logscale y 10 set key font ",20" set title "Input-Tensor Histograms Mapped to the Interval [0,1]" font "Arial,20" -plot for [col=2:8] 'training_inputs_stats.plt' using 1:col with linespoints title columnheader +plot for [col=2:8] 'inputs_stats.plt' using 1:col with linespoints title columnheader pause mouse any "Plot 1 of 2. Press any key to continue.\n" set title "Output-Tensor Histograms Mapped to the Interval [0,1]" font "Arial,20" -plot for [col=2:6] 'training_outputs_stats.plt' using 1:col with linespoints title columnheader +plot for [col=2:6] 'outputs_stats.plt' using 1:col with linespoints title columnheader pause mouse any "Plot 2 of 2. Press any key to exit.\n" diff --git a/demo/app/tensor-statistics.F90 b/demo/app/tensor-statistics.F90 index 214024b10..2edfb00ff 100644 --- a/demo/app/tensor-statistics.F90 +++ b/demo/app/tensor-statistics.F90 @@ -25,7 +25,7 @@ program tensor_statistics 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') // & + ' --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.' & @@ -34,18 +34,20 @@ program tensor_statistics integer(int64) t_start, t_finish, clock_rate integer num_bins, start_step, stride integer, allocatable :: end_step - character(len=:), allocatable :: base_name logical raw + type(string_t), allocatable :: input_file_names(:), output_file_names(:) call system_clock(t_start, clock_rate) - call get_command_line_arguments(base_name, num_bins, start_step, end_step, stride, raw) + call get_command_line_arguments(num_bins, start_step, end_step, stride, raw) + associate(training_configuration => training_configuration_t(file_t("training_configuration.json"))) + call compute_histograms( & - input_tensors_file_name = base_name // "_input.nc" & - ,output_tensors_file_name = base_name // "_output.nc" & + input_tensor_file_names = training_configuration%input_file_names() & + ,output_tensor_file_names = training_configuration%output_file_names() & + ,input_component_names = training_configuration%input_variable_names() & + ,output_component_names = training_configuration%output_variable_names() & ,raw = raw & - , input_names = training_configuration%input_names() & - ,output_names = training_configuration%output_names() & ) end associate call system_clock(t_finish) @@ -65,8 +67,7 @@ program tensor_statistics contains - subroutine get_command_line_arguments(base_name, num_bins, start_step, end_step, stride, raw) - character(len=:), allocatable, intent(out) :: base_name + subroutine get_command_line_arguments(num_bins, start_step, end_step, stride, raw) integer, intent(out) :: num_bins, start_step, stride integer, intent(out), allocatable :: end_step logical, intent(out) :: raw @@ -75,14 +76,13 @@ 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") bins_string = command_line%flag_value("--bins") start_string = command_line%flag_value("--start") end_string = command_line%flag_value("--end") stride_string = command_line%flag_value("--stride") raw = command_line%argument_present(["--raw"]) - associate(required_arguments => len(base_name)/=0 .and. len(bins_string)/=0) + associate(required_arguments => len(bins_string)/=0) if (.not. required_arguments) error stop usage end associate @@ -107,10 +107,10 @@ subroutine get_command_line_arguments(base_name, num_bins, start_step, end_step, end subroutine get_command_line_arguments - subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, raw, input_names, output_names) - character(len=*), intent(in) :: input_tensors_file_name, output_tensors_file_name + subroutine compute_histograms(input_tensor_file_names, output_tensor_file_names, input_component_names, output_component_names, raw) + type(string_t), intent(in) :: input_tensor_file_names(:), output_tensor_file_names(:) + type(string_t), intent(in) :: input_component_names(:), output_component_names(:) logical, intent(in) :: raw - type(string_t), intent(in) :: input_names(:), output_names(:) type(time_derivative_t), allocatable :: derivative(:) type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:) @@ -120,23 +120,21 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, integer(int64) t_histo_start, t_histo_finish integer t, t_end, v - allocate(input_variable(size(input_names))) + allocate(input_variable(size(input_component_names))) - print '(a)',"Reading physics-based model inputs from " // input_tensors_file_name + print '(a)',"Reading physics-based model inputs from " // input_tensor_file_names(1)%string() input_file: & - associate(NetCDF_file => netCDF_file_t(input_tensors_file_name)) + associate(NetCDF_file => netCDF_file_t(input_tensor_file_names(1))) do v=1, size(input_variable) - print '(a)',"- reading " // input_names(v)%string() - call input_variable(v)%input(input_names(v), NetCDF_file, rank=4) + print '(a)',"- reading " // input_component_names(v)%string() + call input_variable(v)%input(input_component_names(v), NetCDF_file, rank=4) end do -#ifdef ASSERTIONS do v = 2, size(input_variable) call_assert(input_variable(v)%conformable_with(input_variable(1))) end do -#endif print '(a)',"- reading time" call input_time%input("time", NetCDF_file, rank=1) @@ -159,36 +157,34 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, histograms_file = to_file(histograms(h)) associate(gnuplot_file_name => histograms(h)%variable_name() // ".plt") print '(a)',"- writing " // gnuplot_file_name - call histograms_file%write_lines(gnuplot_file_name) + call histograms_file%write_lines(string_t(gnuplot_file_name)) end associate end do else histograms_file = to_file(histograms) - associate(gnuplot_file_name => base_name // "_inputs_stats.plt") + associate(gnuplot_file_name => "inputs_stats.plt") print '(a)',"- writing " // gnuplot_file_name - call histograms_file%write_lines(gnuplot_file_name) + call histograms_file%write_lines(string_t(gnuplot_file_name)) end associate end if end block end associate - allocate(output_variable(size(output_names))) + allocate(output_variable(size(output_component_names))) - print '(a)',"Reading physics-based model outputs from " // output_tensors_file_name + print '(a)',"Reading physics-based model outputs from " // output_tensor_file_names(1)%string() output_file: & - associate(NetCDF_file => netCDF_file_t(output_tensors_file_name)) + associate(NetCDF_file => netCDF_file_t(output_tensor_file_names(1))) do v=1, size(output_variable) - print '(a)', "- reading " // output_names(v)%string() - call output_variable(v)%input(output_names(v), NetCDF_file, rank=4) + print '(a)', "- reading " // output_component_names(v)%string() + call output_variable(v)%input(output_component_names(v), NetCDF_file, rank=4) end do -#ifdef ASSERTIONS do v = 2, size(output_variable) call_assert(output_variable(v)%conformable_with(output_variable(1))) end do -#endif print '(a)',"- reading time" call output_time%input("time", NetCDF_file, rank=1) @@ -203,7 +199,7 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, associate(dt => NetCDF_variable_t(output_time - input_time, "dt")) do v = 1, size(derivative) derivative_name: & - associate(derivative_name => "d" // output_names(v)%string() // "_dt") + associate(derivative_name => "d" // output_component_names(v)%string() // "_dt") print '(a)',"- " // derivative_name derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=dt) call_assert(.not. derivative(v)%any_nan()) @@ -227,14 +223,14 @@ subroutine compute_histograms(input_tensors_file_name, output_tensors_file_name, histograms_file = to_file(histograms(h)) associate(gnuplot_file_name => histograms(h)%variable_name() // ".plt") print '(a)',"- writing " // gnuplot_file_name - call histograms_file%write_lines(gnuplot_file_name) + call histograms_file%write_lines(string_t(gnuplot_file_name)) end associate end do else histograms_file = to_file(histograms) - associate(gnuplot_file_name => base_name // "_outputs_stats.plt") + associate(gnuplot_file_name => "outputs_stats.plt") print '(a)',"- writing " // gnuplot_file_name - call histograms_file%write_lines(gnuplot_file_name) + call histograms_file%write_lines(string_t(gnuplot_file_name)) end associate end if end block diff --git a/src/fiats/training_configuration_m.f90 b/src/fiats/training_configuration_m.f90 index a0c6af235..061889471 100644 --- a/src/fiats/training_configuration_m.f90 +++ b/src/fiats/training_configuration_m.f90 @@ -49,20 +49,24 @@ module training_configuration_m end type interface training_configuration_t - module function default_real_from_components(hyperparameters, network_configuration, tensor_names) result(training_configuration) + pure module function default_real_from_components(hyperparameters, network_configuration, tensor_names, training_data_file_names) & + result(training_configuration) implicit none type(hyperparameters_t), intent(in) :: hyperparameters type(network_configuration_t), intent(in) :: network_configuration type(training_configuration_t) training_configuration type(tensor_names_t), intent(in) :: tensor_names + type(training_data_file_names_t), intent(in) :: training_data_file_names end function - module function double_precision_from_components(hyperparameters, network_configuration, tensor_names) result(training_configuration) + pure module function double_precision_from_components(hyperparameters, network_configuration, tensor_names, training_data_file_names) & + result(training_configuration) implicit none type(hyperparameters_t(double_precision)), intent(in) :: hyperparameters type(network_configuration_t), intent(in) :: network_configuration type(tensor_names_t), intent(in) :: tensor_names type(training_configuration_t(double_precision)) training_configuration + type(training_data_file_names_t), intent(in) :: training_data_file_names end function module function default_real_from_file(file_object) result(training_configuration) diff --git a/src/fiats/training_configuration_s.F90 b/src/fiats/training_configuration_s.F90 index b1e4e1b2b..3f248b413 100644 --- a/src/fiats/training_configuration_s.F90 +++ b/src/fiats/training_configuration_s.F90 @@ -14,6 +14,7 @@ training_configuration%hyperparameters_ = hyperparameters training_configuration%network_configuration_ = network_configuration training_configuration%tensor_names_ = tensor_names + training_configuration%training_data_file_names_ = training_data_file_names training_configuration%file_t = file_t([ & string_t(header), & @@ -22,6 +23,8 @@ training_configuration%network_configuration_%to_json(), & string_t(separator), & training_configuration%tensor_names_%to_json(), & + string_t(separator), & + training_configuration%training_data_file_names_%to_json(), & string_t(footer) & ]) @@ -32,6 +35,7 @@ training_configuration%hyperparameters_ = hyperparameters training_configuration%network_configuration_ = network_configuration training_configuration%tensor_names_ = tensor_names + training_configuration%training_data_file_names_ = training_data_file_names training_configuration%file_t = file_t([ & string_t(header), & @@ -40,6 +44,8 @@ training_configuration%network_configuration_%to_json(), & string_t(separator), & training_configuration%tensor_names_%to_json(), & + string_t(separator), & + training_configuration%training_data_file_names_%to_json(), & string_t(footer) & ]) end procedure @@ -60,6 +66,7 @@ training_configuration%hyperparameters_ = hyperparameters_t(lines) training_configuration%network_configuration_= network_configuration_t(lines) training_configuration%tensor_names_ = tensor_names_t(lines) + training_configuration%training_data_file_names_ = training_data_file_names_t(lines) #if ! defined _CRAYFTN end associate @@ -83,6 +90,7 @@ training_configuration%hyperparameters_ = hyperparameters_t(lines) training_configuration%network_configuration_= network_configuration_t(lines) training_configuration%tensor_names_ = tensor_names_t(lines) + training_configuration%training_data_file_names_ = training_data_file_names_t(lines) #if ! defined _CRAYFTN end associate @@ -101,14 +109,16 @@ lhs_eq_rhs = & lhs%hyperparameters_ == rhs%hyperparameters_ .and. & lhs%network_configuration_ == rhs%network_configuration_ .and. & - lhs%tensor_names_ == rhs%tensor_names_ + lhs%tensor_names_ == rhs%tensor_names_ .and. & + lhs%training_data_file_names_ == rhs%training_data_file_names_ end procedure module procedure double_precision_equals lhs_eq_rhs = & lhs%hyperparameters_ == rhs%hyperparameters_ .and. & lhs%network_configuration_ == rhs%network_configuration_ .and. & - lhs%tensor_names_ == rhs%tensor_names_ + lhs%tensor_names_ == rhs%tensor_names_ .and. & + lhs%training_data_file_names_ == rhs%training_data_file_names_ end procedure module procedure default_real_mini_batches diff --git a/src/fiats/training_data_file_names_s.F90 b/src/fiats/training_data_file_names_s.F90 index 1a9d97c93..315bf12ab 100644 --- a/src/fiats/training_data_file_names_s.F90 +++ b/src/fiats/training_data_file_names_s.F90 @@ -21,7 +21,7 @@ character(len=*), parameter :: indent = repeat(" ",ncopies=4) lines = [ & - string_t(indent // '"' //training_data_file_names_key // '": {' ) & + string_t(indent // '"' //training_data_file_names_key // '": {' ) & ,string_t(indent // indent // '"' // path_key // '" : "' // self%path_ // '",') & ,string_t(indent // indent // '"' // inputs_prefix_key // '" : "' // self%inputs_prefix_ // '",') & ,string_t(indent // indent // '"' // outputs_prefix_key // '" : "' // self%outputs_prefix_ // '",') & From 15205ea3d64734193021255df32c09648b55e4b1 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 8 Apr 2025 20:17:56 -0600 Subject: [PATCH 18/22] fix time derivative --- demo/app/tensor-statistics.F90 | 36 +++++++++++++----------- demo/app/train-cloud-microphysics.F90 | 9 +++--- demo/src/NetCDF_variable_m.f90 | 19 +++++++++++-- demo/src/NetCDF_variable_s.F90 | 25 ++++++++++++---- demo/src/time_data_m.F90 | 8 ++++++ demo/src/time_data_s.F90 | 9 ++++-- demo/test/time_data_test_m.F90 | 2 +- src/fiats/training_configuration_m.f90 | 30 ++++++++++++++------ src/fiats/training_configuration_s.F90 | 8 ++++++ src/fiats/training_data_file_names_m.f90 | 16 ++++++++++- src/fiats/training_data_file_names_s.F90 | 10 ++++++- 11 files changed, 130 insertions(+), 42 deletions(-) diff --git a/demo/app/tensor-statistics.F90 b/demo/app/tensor-statistics.F90 index 2edfb00ff..967ec7062 100644 --- a/demo/app/tensor-statistics.F90 +++ b/demo/app/tensor-statistics.F90 @@ -19,17 +19,16 @@ program tensor_statistics use NetCDF_file_m, only: NetCDF_file_t use NetCDF_variable_m, only: NetCDF_variable_t, time_derivative_t use histogram_m, only: histogram_t, to_file - use training_configuration_m, only : training_configuration_t + use time_data_m, only: time_data_t, icar_output_file_t + use fiats_m, only : training_configuration_t 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') // & - ' --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') + character(len=*), parameter :: usage = new_line('') // new_line('') // & + 'Usage: ' // new_line('') // new_line('') // & + './build/run-fpm.sh run tensor-statistics -- --bins \' // new_line('') // & + ' [--raw] [--start ] [--end ] [--stride ]' // & + new_line('') // new_line('') // & + 'where angular brackets denote user-provided values and square brackets denote optional arguments.' // new_line('') integer(int64) t_start, t_finish, clock_rate integer num_bins, start_step, stride @@ -47,6 +46,7 @@ program tensor_statistics ,output_tensor_file_names = training_configuration%output_file_names() & ,input_component_names = training_configuration%input_variable_names() & ,output_component_names = training_configuration%output_variable_names() & + ,time_data_file_name = training_configuration%time_data_file_name() & ,raw = raw & ) end associate @@ -107,15 +107,17 @@ subroutine get_command_line_arguments(num_bins, start_step, end_step, stride, ra end subroutine get_command_line_arguments - subroutine compute_histograms(input_tensor_file_names, output_tensor_file_names, input_component_names, output_component_names, raw) + subroutine compute_histograms( & + input_tensor_file_names, output_tensor_file_names, input_component_names, output_component_names, time_data_file_name, raw & + ) type(string_t), intent(in) :: input_tensor_file_names(:), output_tensor_file_names(:) - type(string_t), intent(in) :: input_component_names(:), output_component_names(:) + type(string_t), intent(in) :: input_component_names(:), output_component_names(:), time_data_file_name logical, intent(in) :: raw type(time_derivative_t), allocatable :: derivative(:) type(NetCDF_variable_t), allocatable :: input_variable(:), output_variable(:) type(NetCDF_variable_t) input_time, output_time - double precision, allocatable, dimension(:) :: time_in, time_out + double precision, allocatable, dimension(:) :: dt double precision, parameter :: tolerance = 1.E-07 integer(int64) t_histo_start, t_histo_finish integer t, t_end, v @@ -136,7 +138,7 @@ subroutine compute_histograms(input_tensor_file_names, output_tensor_file_names, call_assert(input_variable(v)%conformable_with(input_variable(1))) end do - print '(a)',"- reading time" + print '(a)',"- reading time from NetCDF file" call input_time%input("time", NetCDF_file, rank=1) end associate input_file @@ -195,17 +197,17 @@ subroutine compute_histograms(input_tensor_file_names, output_tensor_file_names, allocate(derivative(size(output_variable))) - dt: & - associate(dt => NetCDF_variable_t(output_time - input_time, "dt")) + print '(a)',"- reading time from JSON file" + associate(time_data => time_data_t(file_t(time_data_file_name))) do v = 1, size(derivative) derivative_name: & associate(derivative_name => "d" // output_component_names(v)%string() // "_dt") print '(a)',"- " // derivative_name - derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=dt) + derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=time_data%dt()) call_assert(.not. derivative(v)%any_nan()) end associate derivative_name end do - end associate dt + end associate print '(a)',"Calculating histograms for the desired neural-network outputs." call system_clock(t_histo_start) diff --git a/demo/app/train-cloud-microphysics.F90 b/demo/app/train-cloud-microphysics.F90 index f92e4474a..2996239b4 100644 --- a/demo/app/train-cloud-microphysics.F90 +++ b/demo/app/train-cloud-microphysics.F90 @@ -23,6 +23,7 @@ program train_cloud_microphysics use NetCDF_variable_m, only: NetCDF_variable_t, tensors, time_derivative_t use occupancy_m, only : occupancy_t use default_m, only: default_or_internal_read + use time_data_m, only: time_data_t implicit none @@ -232,17 +233,17 @@ subroutine read_train_write(training_configuration, args, plot_file) allocate(derivative(size(output_variable))) - dt: & - associate(dt => NetCDF_variable_t(output_time - input_time, "dt")) + print '(a)',"- reading time from JSON file" + associate(time_data => time_data_t(file_t(training_configuration%time_data_file_name()))) do v = 1, size(derivative) derivative_name: & associate(derivative_name => "d" // output_names(v)%string() // "/dt") print *,"- " // derivative_name - derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=dt) + derivative(v) = time_derivative_t(old = input_variable(v), new = output_variable(v), dt=time_data%dt()) call_assert(.not. derivative(v)%any_nan()) end associate derivative_name end do - end associate dt + end associate end associate output_names if (allocated(args%end_step)) then diff --git a/demo/src/NetCDF_variable_m.f90 b/demo/src/NetCDF_variable_m.f90 index 9b67d8a78..ce455a42d 100644 --- a/demo/src/NetCDF_variable_m.f90 +++ b/demo/src/NetCDF_variable_m.f90 @@ -37,6 +37,8 @@ module NetCDF_variable_m procedure, private, non_overridable :: default_real_subtract , double_precision_subtract generic :: histogram => default_real_histogram , double_precision_histogram procedure, private, non_overridable :: default_real_histogram , double_precision_histogram + generic :: compare => default_real_compare , double_precision_compare + procedure, private, non_overridable :: default_real_compare , double_precision_compare end type type, extends(NetCDF_variable_t) :: time_derivative_t(k) @@ -45,9 +47,10 @@ module NetCDF_variable_m interface time_derivative_t - impure elemental module function default_real_time_derivative(old, new, dt) result(time_derivative) + module function default_real_time_derivative(old, new, dt) result(time_derivative) implicit none - type(NetCDF_variable_t), intent(in) :: old, new, dt + type(NetCDF_variable_t), intent(in) :: old, new + real, intent(in) :: dt(:) type(time_derivative_t) time_derivative end function @@ -238,6 +241,18 @@ elemental module function double_precision_histogram(self, num_bins, raw) result type(histogram_t) histogram end function + module subroutine default_real_compare(self, values) + implicit none + class(NetCDF_variable_t), intent(in) :: self + type(string_t), intent(in) :: values(:) + end subroutine + + module subroutine double_precision_compare(self, values) + implicit none + class(NetCDF_variable_t(double_precision)), intent(in) :: self + type(string_t), intent(in) :: values(:) + end subroutine + end interface end module \ No newline at end of file diff --git a/demo/src/NetCDF_variable_s.F90 b/demo/src/NetCDF_variable_s.F90 index 00c39b5d8..b00331e25 100644 --- a/demo/src/NetCDF_variable_s.F90 +++ b/demo/src/NetCDF_variable_s.F90 @@ -29,7 +29,6 @@ module procedure default_real_time_derivative - call_assert(dt%rank()==1) call_assert(new%conformable_with(old)) call_assert(old%name_==new%name_) @@ -42,22 +41,22 @@ case(1) allocate(time_derivative%values_1D_, mold = old%values_1D_) do concurrent(t = 1:size(old%values_1D_)) - time_derivative%values_1D_(t) = (new%values_1D_(t) - old%values_1D_(t))/ dt%values_1D_(t) + time_derivative%values_1D_(t) = (new%values_1D_(t) - old%values_1D_(t))/ dt(t) end do case(2) allocate(time_derivative%values_2D_, mold = old%values_2D_) do concurrent(t = 1:size(old%values_2D_,2)) - time_derivative%values_2D_(:,t) = (new%values_2D_(:,t) - old%values_2D_(:,t))/ dt%values_1D_(t) + time_derivative%values_2D_(:,t) = (new%values_2D_(:,t) - old%values_2D_(:,t))/ dt(t) end do case(3) allocate(time_derivative%values_3D_, mold = old%values_3D_) do concurrent(t = 1:size(old%values_3D_,3)) - time_derivative%values_3D_(:,:,t) = (new%values_3D_(:,:,t) - old%values_3D_(:,:,t))/ dt%values_1D_(t) + time_derivative%values_3D_(:,:,t) = (new%values_3D_(:,:,t) - old%values_3D_(:,:,t))/ dt(t) end do case(4) allocate(time_derivative%values_4D_, mold = old%values_4D_) do concurrent(t = 1:size(old%values_4D_,4)) - time_derivative%values_4D_(:,:,:,t) = (new%values_4D_(:,:,:,t) - old%values_4D_(:,:,:,t))/ dt%values_1D_(t) + time_derivative%values_4D_(:,:,:,t) = (new%values_4D_(:,:,:,t) - old%values_4D_(:,:,:,t))/ dt(t) end do case default error stop "NetCDF_variable_s(default_real_time_derivative): unsupported rank)" @@ -508,4 +507,20 @@ pure function double_precision_upper_bounds(NetCDF_variable) result(ubounds) end select end procedure + module procedure default_real_compare + integer i + print *, "Sizes = ", size(self%values_1D_), size(values) + do i=1, min(size(self%values_1D_), size(values)) + print *, self%values_1D_(i), values(i)%string() + end do + end procedure + + module procedure double_precision_compare + integer i + print *, "Sizes = ", size(self%values_1D_), size(values) + do i=1, min(size(self%values_1D_), size(values)) + print *, self%values_1D_(i), ", ", values(i)%string() + end do + end procedure + end submodule NetCDF_variable_s \ No newline at end of file diff --git a/demo/src/time_data_m.F90 b/demo/src/time_data_m.F90 index 834bc80bb..53cc378c8 100644 --- a/demo/src/time_data_m.F90 +++ b/demo/src/time_data_m.F90 @@ -20,6 +20,8 @@ module time_data_m procedure, private :: default_real_to_json generic :: dt => default_real_dt procedure, private :: default_real_dt + generic :: times => default_real_times + procedure, private :: default_real_times end type type, extends(file_t) :: icar_output_file_t @@ -85,6 +87,12 @@ pure module function default_real_dt(self) result(dt_values) real, allocatable :: dt_values(:) end function + pure module function default_real_times(self) result(times) + implicit none + class(time_data_t), intent(in) :: self + type(string_t), allocatable :: times(:) + end function + end interface end module time_data_m diff --git a/demo/src/time_data_s.F90 b/demo/src/time_data_s.F90 index 6438ba1cd..7a774f54f 100644 --- a/demo/src/time_data_s.F90 +++ b/demo/src/time_data_s.F90 @@ -32,11 +32,10 @@ i = 3 time_data%date_ = lines(i)%get_json_value(key="dates", mold=[string_t::]) i = 4 - time_data%date_ = lines(i)%get_json_value(key="times", mold=[string_t::]) + time_data%time_ = lines(i)%get_json_value(key="times", mold=[string_t::]) i = 5 time_data%dt_= lines(i)%get_json_value(key="dt", mold=[real::]) end associate - end procedure module procedure default_real_from_strings @@ -67,7 +66,7 @@ allocate(time_data%date_(num_lines)) allocate(time_data%time_(num_lines)) allocate(time_data%dt_(num_lines)) - + do line = 1, num_lines associate(raw_line => lines(line)%string()) call_assert(raw_line(1:len(preface))==preface) @@ -125,4 +124,8 @@ dt_values = self%dt_ end procedure + module procedure default_real_times + times = self%time_ + end procedure + end submodule time_data_s diff --git a/demo/test/time_data_test_m.F90 b/demo/test/time_data_test_m.F90 index 876afad5a..c29e59c80 100644 --- a/demo/test/time_data_test_m.F90 +++ b/demo/test/time_data_test_m.F90 @@ -92,7 +92,7 @@ function write_then_read_json() result(test_diagnosis) associate(time_data => time_data_t( & date = string_t(["2010/10/01", "2010/10/01", "2010/10/01"]) & ,time = string_t([ "03:16:00", "06:36:00", "09:56:00"]) & - ,dt = [120.000000, 120.000000, 120.000000] & + ,dt = [expected_dt, expected_dt, expected_dt] & ) ) associate(json_file => time_data%to_json()) associate(from_json => time_data_t(json_file)) diff --git a/src/fiats/training_configuration_m.f90 b/src/fiats/training_configuration_m.f90 index 061889471..398b59611 100644 --- a/src/fiats/training_configuration_m.f90 +++ b/src/fiats/training_configuration_m.f90 @@ -38,14 +38,16 @@ module training_configuration_m procedure, private :: default_real_nodes_per_layer , double_precision_nodes_per_layer generic :: skip_connections => default_real_skip_connections, double_precision_skip_connections procedure, private :: default_real_skip_connections, double_precision_skip_connections - generic :: input_variable_names => default_real_input_names , double_precision_input_names - procedure, private :: default_real_input_names , double_precision_input_names - generic :: output_variable_names => default_real_output_names , double_precision_output_names - procedure, private :: default_real_output_names , double_precision_output_names - generic :: input_file_names => default_real_input_file_names, double_precision_input_file_names - procedure, private :: default_real_input_file_names, double_precision_input_file_names - generic :: output_file_names => default_real_output_file_names, double_precision_output_file_names - procedure, private :: default_real_output_file_names, double_precision_output_file_names + generic :: input_variable_names => default_real_input_names , double_precision_input_names + procedure, private :: default_real_input_names , double_precision_input_names + generic :: output_variable_names => default_real_output_names , double_precision_output_names + procedure, private :: default_real_output_names , double_precision_output_names + generic :: input_file_names => default_real_input_file_names , double_precision_input_file_names + procedure, private :: default_real_input_file_names , double_precision_input_file_names + generic :: output_file_names => default_real_output_file_names , double_precision_output_file_names + procedure, private :: default_real_output_file_names , double_precision_output_file_names + generic :: time_data_file_name => default_real_time_data_file_name, double_precision_time_data_file_name + procedure, private :: default_real_time_data_file_name, double_precision_time_data_file_name end type interface training_configuration_t @@ -229,6 +231,18 @@ pure module function double_precision_output_file_names(self) result(names) type(string_t), allocatable :: names(:) end function + pure module function default_real_time_data_file_name(self) result(name) + implicit none + class(training_configuration_t), intent(in) :: self + type(string_t) name + end function + + pure module function double_precision_time_data_file_name(self) result(name) + implicit none + class(training_configuration_t(double_precision)), intent(in) :: self + type(string_t) name + end function + end interface end module diff --git a/src/fiats/training_configuration_s.F90 b/src/fiats/training_configuration_s.F90 index 3f248b413..980d188d9 100644 --- a/src/fiats/training_configuration_s.F90 +++ b/src/fiats/training_configuration_s.F90 @@ -241,4 +241,12 @@ names = self%training_data_file_names_%fully_qualified_outputs_files() end procedure + module procedure default_real_time_data_file_name + name = self%training_data_file_names_%fully_qualified_time_file() + end procedure + + module procedure double_precision_time_data_file_name + name = self%training_data_file_names_%fully_qualified_time_file() + end procedure + end submodule training_configuration_s diff --git a/src/fiats/training_data_file_names_m.f90 b/src/fiats/training_data_file_names_m.f90 index b37a093d1..ab22b1a9e 100644 --- a/src/fiats/training_data_file_names_m.f90 +++ b/src/fiats/training_data_file_names_m.f90 @@ -15,13 +15,15 @@ module training_data_file_names_m procedure :: to_json procedure :: fully_qualified_inputs_files procedure :: fully_qualified_outputs_files + procedure :: fully_qualified_time_file + procedure :: path generic :: operator(==) => equals procedure, private :: equals end type interface training_data_file_names_t - module function from_json(lines) result(training_data_file_names) + pure module function from_json(lines) result(training_data_file_names) implicit none class(string_t), intent(in) :: lines(:) type(training_data_file_names_t) training_data_file_names @@ -38,6 +40,12 @@ pure module function from_components(path, inputs_prefix, outputs_prefix, infixe interface + pure module function path(self) result(training_data_file_path) + implicit none + class(training_data_file_names_t), intent(in) :: self + character(len=:), allocatable :: training_data_file_path + end function + elemental module function equals(lhs, rhs) result(lhs_eq_rhs) implicit none class(training_data_file_names_t), intent(in) :: lhs, rhs @@ -62,6 +70,12 @@ pure module function fully_qualified_outputs_files(self) result(names) type(string_t), allocatable :: names(:) end function + pure module function fully_qualified_time_file(self) result(name) + implicit none + class(training_data_file_names_t), intent(in) :: self + type(string_t) name + end function + end interface end module diff --git a/src/fiats/training_data_file_names_s.F90 b/src/fiats/training_data_file_names_s.F90 index 315bf12ab..13e2ed559 100644 --- a/src/fiats/training_data_file_names_s.F90 +++ b/src/fiats/training_data_file_names_s.F90 @@ -17,6 +17,14 @@ contains + module procedure path + training_data_file_path = self%path_ + end procedure + + module procedure fully_qualified_time_file + name = self%path_ // "/dt.json" + end procedure + module procedure to_json character(len=*), parameter :: indent = repeat(" ",ncopies=4) @@ -39,7 +47,7 @@ do l=1,size(lines) if (lines(l)%get_json_key() == training_data_file_names_key) then training_data_file_names_key_found = .true. - training_data_file_names%path_ = lines(l+1)%get_json_value(string_t(path_key), mold=string_t("")) + training_data_file_names%path_ = lines(l+1)%get_json_value(string_t(path_key), mold=string_t("")) // "/" training_data_file_names%inputs_prefix_ = lines(l+2)%get_json_value(string_t(inputs_prefix_key), mold=string_t("")) training_data_file_names%outputs_prefix_ = lines(l+3)%get_json_value(string_t(outputs_prefix_key), mold=string_t("")) training_data_file_names%infixes_ = lines(l+4)%get_json_value(string_t(infixes_key), mold=[string_t("")]) From 3daed4edf9067f5fe5f00d721eb64db5bbc99ccb Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Sat, 12 Apr 2025 15:58:43 -0700 Subject: [PATCH 19/22] fix(time_data_s): demo app tensor-stats assertions Running demo/app/tensor-statistics.F90 now builds and terminates normally with -DASSERTIONS. --- demo/src/time_data_s.F90 | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/demo/src/time_data_s.F90 b/demo/src/time_data_s.F90 index 7a774f54f..bbb9546ef 100644 --- a/demo/src/time_data_s.F90 +++ b/demo/src/time_data_s.F90 @@ -24,17 +24,13 @@ associate(lines => file%lines()) i = 1 call_assert_diagnose(adjustl(lines(i)%string())=='{'," default_real_json(time_data_s): object start", lines(i)%string()) - call_assert(allocated(file%date_)) - call_assert(allocated(file%time_)) - call_assert(allocated(file%dt_)) - call_assert(all(size(file%date_) == [size(file%time_), size(file%dt_)])) - call_assert(.false.) i = 3 time_data%date_ = lines(i)%get_json_value(key="dates", mold=[string_t::]) i = 4 time_data%time_ = lines(i)%get_json_value(key="times", mold=[string_t::]) i = 5 time_data%dt_= lines(i)%get_json_value(key="dt", mold=[real::]) + call_assert(all(size(time_data%date_) == [size(time_data%time_), size(time_data%dt_)])) end associate end procedure From fa733488a488b38056ca0c00c15bb7e2ae5eea7b Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 14 Apr 2025 21:57:56 -0700 Subject: [PATCH 20/22] chore: update copyright years to year range --- example/concurrent-inferences.f90 | 2 +- example/print-training-configuration.F90 | 16 +--------------- src/fiats/activation_m.f90 | 2 +- src/fiats/activation_s.F90 | 2 +- src/fiats/double_precision_file_m.f90 | 2 +- src/fiats/double_precision_file_s.f90 | 2 +- src/fiats/double_precision_string_m.f90 | 2 +- src/fiats/double_precision_string_s.f90 | 2 +- src/fiats/hyperparameters_m.f90 | 2 +- src/fiats/hyperparameters_s.F90 | 2 +- src/fiats/input_output_pair_m.f90 | 2 +- src/fiats/input_output_pair_s.f90 | 2 +- src/fiats/kind_parameters_m.f90 | 2 +- src/fiats/layer_m.f90 | 2 +- src/fiats/layer_s.F90 | 2 +- src/fiats/metadata_m.f90 | 2 +- src/fiats/metadata_s.F90 | 2 +- src/fiats/mini_batch_m.f90 | 2 +- src/fiats/mini_batch_s.f90 | 2 +- src/fiats/network_configuration_m.f90 | 2 +- src/fiats/network_configuration_s.F90 | 2 +- src/fiats/neural_network_m.f90 | 2 +- src/fiats/neural_network_s.F90 | 2 +- src/fiats/neuron_m.f90 | 2 +- src/fiats/neuron_s.F90 | 2 +- src/fiats/tensor_m.f90 | 2 +- src/fiats/tensor_map_m.f90 | 2 +- src/fiats/tensor_map_s.F90 | 2 +- src/fiats/tensor_names_m.f90 | 2 +- src/fiats/tensor_names_s.F90 | 2 +- src/fiats/tensor_s.f90 | 2 +- src/fiats/trainable_network_m.f90 | 2 +- src/fiats/trainable_network_s.F90 | 2 +- src/fiats/unmapped_network_s.F90 | 2 +- src/fiats/workspace_s.F90 | 2 +- src/fiats_m.f90 | 4 ++-- 36 files changed, 37 insertions(+), 51 deletions(-) diff --git a/example/concurrent-inferences.f90 b/example/concurrent-inferences.f90 index 6bb5a436c..d742f0996 100644 --- a/example/concurrent-inferences.f90 +++ b/example/concurrent-inferences.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt program concurrent_inferences !! This program demonstrates how to read a neural network from a JSON file diff --git a/example/print-training-configuration.F90 b/example/print-training-configuration.F90 index 300d2030c..66ab19369 100644 --- a/example/print-training-configuration.F90 +++ b/example/print-training-configuration.F90 @@ -1,11 +1,10 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2024-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt program print_training_configuration !! Demonstrate how to construct and print a training_configuration_t object use fiats_m, only : training_configuration_t, hyperparameters_t, network_configuration_t, tensor_names_t use julienne_m, only : file_t, string_t implicit none -#ifndef _CRAYFTN associate(training_configuration => training_configuration_t( & hyperparameters_t(mini_batches=10, learning_rate=1.5, optimizer = "adam") & ,network_configuration_t(skip_connections=.false., nodes_per_layer=[2,72,2], activation_name="sigmoid") & @@ -15,17 +14,4 @@ program print_training_configuration call json_file%write_lines() end associate end associate -#else - block - type(training_configuration_t) :: training_configuration - type(file_t) :: json_file - training_configuration = training_configuration_t( & - hyperparameters_t(mini_batches=10, learning_rate=1.5, optimizer = "adam") & - ,network_configuration_t(skip_connections=.false., nodes_per_layer=[2,72,2], activation_name="sigmoid") & - ,tensorm_names_t(inputs=[string_t("pressure"), string_t("temperature")], outputs([string_t("saturated mixing ratio")])) & - ) - json_file = file_t(training_configuration%to_json()) - call json_file%write_lines() - end block -#endif end program diff --git a/src/fiats/activation_m.f90 b/src/fiats/activation_m.f90 index 8e5948386..b1527b63b 100644 --- a/src/fiats/activation_m.f90 +++ b/src/fiats/activation_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module activation_m diff --git a/src/fiats/activation_s.F90 b/src/fiats/activation_s.F90 index ddff57c46..ca4233412 100644 --- a/src/fiats/activation_s.F90 +++ b/src/fiats/activation_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/double_precision_file_m.f90 b/src/fiats/double_precision_file_m.f90 index f62506a42..2cc2a214e 100644 --- a/src/fiats/double_precision_file_m.f90 +++ b/src/fiats/double_precision_file_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module double_precision_file_m use julienne_m, only : file_t, string_t diff --git a/src/fiats/double_precision_file_s.f90 b/src/fiats/double_precision_file_s.f90 index 620e95291..b34c11f54 100644 --- a/src/fiats/double_precision_file_s.f90 +++ b/src/fiats/double_precision_file_s.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(double_precision_file_m) double_precision_file_s implicit none diff --git a/src/fiats/double_precision_string_m.f90 b/src/fiats/double_precision_string_m.f90 index 01b2f19d2..2572451c3 100644 --- a/src/fiats/double_precision_string_m.f90 +++ b/src/fiats/double_precision_string_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module double_precision_string_m use julienne_m, only : string_t diff --git a/src/fiats/double_precision_string_s.f90 b/src/fiats/double_precision_string_s.f90 index b0cecd45c..8aa1710bb 100644 --- a/src/fiats/double_precision_string_s.f90 +++ b/src/fiats/double_precision_string_s.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(double_precision_string_m)double_precision_string_s implicit none diff --git a/src/fiats/hyperparameters_m.f90 b/src/fiats/hyperparameters_m.f90 index d7fc5c464..56134fec5 100644 --- a/src/fiats/hyperparameters_m.f90 +++ b/src/fiats/hyperparameters_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module hyperparameters_m use julienne_string_m, only : string_t diff --git a/src/fiats/hyperparameters_s.F90 b/src/fiats/hyperparameters_s.F90 index 277b06890..0038279f2 100644 --- a/src/fiats/hyperparameters_s.F90 +++ b/src/fiats/hyperparameters_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/input_output_pair_m.f90 b/src/fiats/input_output_pair_m.f90 index 047f2ba5c..6ad6f50e6 100644 --- a/src/fiats/input_output_pair_m.f90 +++ b/src/fiats/input_output_pair_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module input_output_pair_m use tensor_m, only : tensor_t diff --git a/src/fiats/input_output_pair_s.f90 b/src/fiats/input_output_pair_s.f90 index 92a960da8..a263aadff 100644 --- a/src/fiats/input_output_pair_s.f90 +++ b/src/fiats/input_output_pair_s.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(input_output_pair_m) input_output_pair_s implicit none diff --git a/src/fiats/kind_parameters_m.f90 b/src/fiats/kind_parameters_m.f90 index f312a66b6..05772500c 100644 --- a/src/fiats/kind_parameters_m.f90 +++ b/src/fiats/kind_parameters_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module kind_parameters_m implicit none diff --git a/src/fiats/layer_m.f90 b/src/fiats/layer_m.f90 index e877d397a..c8a0eb224 100644 --- a/src/fiats/layer_m.f90 +++ b/src/fiats/layer_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module layer_m use double_precision_string_m, only : double_precision_string_t diff --git a/src/fiats/layer_s.F90 b/src/fiats/layer_s.F90 index 0a368b605..7a9fbde55 100644 --- a/src/fiats/layer_s.F90 +++ b/src/fiats/layer_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/metadata_m.f90 b/src/fiats/metadata_m.f90 index a5d9df6c3..2247bce9f 100644 --- a/src/fiats/metadata_m.f90 +++ b/src/fiats/metadata_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module metadata_m use julienne_string_m, only : string_t diff --git a/src/fiats/metadata_s.F90 b/src/fiats/metadata_s.F90 index 842974cd9..cca0f9148 100644 --- a/src/fiats/metadata_s.F90 +++ b/src/fiats/metadata_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/mini_batch_m.f90 b/src/fiats/mini_batch_m.f90 index 7bb44d7cb..38c92ebf8 100644 --- a/src/fiats/mini_batch_m.f90 +++ b/src/fiats/mini_batch_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module mini_batch_m use input_output_pair_m, only : input_output_pair_t diff --git a/src/fiats/mini_batch_s.f90 b/src/fiats/mini_batch_s.f90 index e4f126505..e90f3a4c0 100644 --- a/src/fiats/mini_batch_s.f90 +++ b/src/fiats/mini_batch_s.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(mini_batch_m) mini_batch_s implicit none diff --git a/src/fiats/network_configuration_m.f90 b/src/fiats/network_configuration_m.f90 index 2822173bc..1d7371a42 100644 --- a/src/fiats/network_configuration_m.f90 +++ b/src/fiats/network_configuration_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module network_configuration_m use julienne_string_m, only : string_t diff --git a/src/fiats/network_configuration_s.F90 b/src/fiats/network_configuration_s.F90 index 867f9989d..789ad27df 100644 --- a/src/fiats/network_configuration_s.F90 +++ b/src/fiats/network_configuration_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/neural_network_m.f90 b/src/fiats/neural_network_m.f90 index 0b78067dd..21cef82af 100644 --- a/src/fiats/neural_network_m.f90 +++ b/src/fiats/neural_network_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module neural_network_m !! Define an abstraction that supports inference operations on a neural network diff --git a/src/fiats/neural_network_s.F90 b/src/fiats/neural_network_s.F90 index 9b0ca5c89..34f15cc0d 100644 --- a/src/fiats/neural_network_s.F90 +++ b/src/fiats/neural_network_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/neuron_m.f90 b/src/fiats/neuron_m.f90 index 45852606a..38e4dd2ff 100644 --- a/src/fiats/neuron_m.f90 +++ b/src/fiats/neuron_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module neuron_m use julienne_string_m, only : string_t diff --git a/src/fiats/neuron_s.F90 b/src/fiats/neuron_s.F90 index aba26b8ce..46d34e563 100644 --- a/src/fiats/neuron_s.F90 +++ b/src/fiats/neuron_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/tensor_m.f90 b/src/fiats/tensor_m.f90 index 425a899bb..a7e3a9e9c 100644 --- a/src/fiats/tensor_m.f90 +++ b/src/fiats/tensor_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module tensor_m use kind_parameters_m, only : default_real, double_precision diff --git a/src/fiats/tensor_map_m.f90 b/src/fiats/tensor_map_m.f90 index 1343343fb..5fc36d669 100644 --- a/src/fiats/tensor_map_m.f90 +++ b/src/fiats/tensor_map_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module tensor_map_m use tensor_m, only : tensor_t diff --git a/src/fiats/tensor_map_s.F90 b/src/fiats/tensor_map_s.F90 index 106b28773..d4ac6fbb9 100644 --- a/src/fiats/tensor_map_s.F90 +++ b/src/fiats/tensor_map_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/tensor_names_m.f90 b/src/fiats/tensor_names_m.f90 index b1c1a9723..69f912988 100644 --- a/src/fiats/tensor_names_m.f90 +++ b/src/fiats/tensor_names_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module tensor_names_m use julienne_string_m, only : string_t diff --git a/src/fiats/tensor_names_s.F90 b/src/fiats/tensor_names_s.F90 index c132e2d9d..02be58e68 100644 --- a/src/fiats/tensor_names_s.F90 +++ b/src/fiats/tensor_names_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/tensor_s.f90 b/src/fiats/tensor_s.f90 index c0cf3fbb3..44a9364e5 100644 --- a/src/fiats/tensor_s.f90 +++ b/src/fiats/tensor_s.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(tensor_m) tensor_s implicit none diff --git a/src/fiats/trainable_network_m.f90 b/src/fiats/trainable_network_m.f90 index 0deec7470..fc19daf29 100644 --- a/src/fiats/trainable_network_m.f90 +++ b/src/fiats/trainable_network_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module trainable_network_m diff --git a/src/fiats/trainable_network_s.F90 b/src/fiats/trainable_network_s.F90 index 58ec6986e..046e2b095 100644 --- a/src/fiats/trainable_network_s.F90 +++ b/src/fiats/trainable_network_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(trainable_network_m) trainable_network_s diff --git a/src/fiats/unmapped_network_s.F90 b/src/fiats/unmapped_network_s.F90 index 82b7ca5e2..f9dde8dad 100644 --- a/src/fiats/unmapped_network_s.F90 +++ b/src/fiats/unmapped_network_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-20225, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats/workspace_s.F90 b/src/fiats/workspace_s.F90 index 290b33957..d17513733 100644 --- a/src/fiats/workspace_s.F90 +++ b/src/fiats/workspace_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt #include "assert_macros.h" diff --git a/src/fiats_m.f90 b/src/fiats_m.f90 index 04ca2967b..bfc295338 100644 --- a/src/fiats_m.f90 +++ b/src/fiats_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module fiats_m !! Specify the user-facing modules, derived types, and type parameters @@ -16,6 +16,6 @@ module fiats_m use tensor_names_m, only : tensor_names_t use trainable_network_m, only : trainable_network_t use training_configuration_m, only : training_configuration_t - use training_data_file_names_m, only : training_data_file_names_t + use training_data_files_m, only : training_data_files_t implicit none end module fiats_m From 85786cd126d8f99e98edf911c9fb7e80f9951446 Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Mon, 14 Apr 2025 22:01:05 -0700 Subject: [PATCH 21/22] refac(training_data):separate from training_config --- demo/app/tensor-statistics.F90 | 11 +-- demo/training_configuration.json | 10 +-- src/fiats/training_configuration_m.f90 | 92 ++++++------------------ src/fiats/training_configuration_s.F90 | 80 +-------------------- src/fiats/training_data_file_names_m.f90 | 81 --------------------- src/fiats/training_data_file_names_s.F90 | 85 ---------------------- test/main.F90 | 6 +- test/training_data_file_names_test_m.F90 | 73 ------------------- 8 files changed, 37 insertions(+), 401 deletions(-) delete mode 100644 src/fiats/training_data_file_names_m.f90 delete mode 100644 src/fiats/training_data_file_names_s.F90 delete mode 100644 test/training_data_file_names_test_m.F90 diff --git a/demo/app/tensor-statistics.F90 b/demo/app/tensor-statistics.F90 index 967ec7062..a68da19e3 100644 --- a/demo/app/tensor-statistics.F90 +++ b/demo/app/tensor-statistics.F90 @@ -20,7 +20,7 @@ program tensor_statistics use NetCDF_variable_m, only: NetCDF_variable_t, time_derivative_t use histogram_m, only: histogram_t, to_file use time_data_m, only: time_data_t, icar_output_file_t - use fiats_m, only : training_configuration_t + use fiats_m, only : training_configuration_t, training_data_files_t implicit none character(len=*), parameter :: usage = new_line('') // new_line('') // & @@ -39,11 +39,14 @@ program tensor_statistics call system_clock(t_start, clock_rate) call get_command_line_arguments(num_bins, start_step, end_step, stride, raw) - associate(training_configuration => training_configuration_t(file_t("training_configuration.json"))) + associate( & + training_configuration => training_configuration_t(file_t("training_configuration.json")) & + ,training_data_files => training_data_files_t(file_t("training_data_files.json")) & + ) call compute_histograms( & - input_tensor_file_names = training_configuration%input_file_names() & - ,output_tensor_file_names = training_configuration%output_file_names() & + input_tensor_file_names = training_data_files%input_file_names() & + ,output_tensor_file_names = training_data_files%output_file_names() & ,input_component_names = training_configuration%input_variable_names() & ,output_component_names = training_configuration%output_variable_names() & ,time_data_file_name = training_configuration%time_data_file_name() & diff --git a/demo/training_configuration.json b/demo/training_configuration.json index d47f658d6..367daa6fb 100644 --- a/demo/training_configuration.json +++ b/demo/training_configuration.json @@ -3,22 +3,14 @@ "mini-batches" : 10, "learning rate" : 1.50000000, "optimizer" : "adam" - } - , + }, "network configuration": { "skip connections" : false, "nodes per layer" : [7,32,32,32,5], "activation function" : "sigmoid" }, - , "tensor names": { "inputs" : ["potential_temperature","qv", "qc", "qr", "qs", "pressure", "temperature"], "outputs" : ["potential_temperature","qv", "qc", "qr", "qs"] - }, - "training data file names": { - "path" : "dates-20101001-2011076", - "inputs prefix" : "training_input-image-", - "outputs prefix" : "training_output-image-", - "infixes" : ["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"] } } diff --git a/src/fiats/training_configuration_m.f90 b/src/fiats/training_configuration_m.f90 index 398b59611..f16ecf9da 100644 --- a/src/fiats/training_configuration_m.f90 +++ b/src/fiats/training_configuration_m.f90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt module training_configuration_m use activation_m, only : activation_t @@ -9,7 +9,6 @@ module training_configuration_m use kind_parameters_m, only : default_real, double_precision use double_precision_file_m, only : double_precision_file_t use tensor_names_m, only : tensor_names_t - use training_data_file_names_m, only : training_data_file_names_t implicit none private @@ -20,55 +19,46 @@ module training_configuration_m type(hyperparameters_t(m)), private :: hyperparameters_ type(network_configuration_t), private :: network_configuration_ type(tensor_names_t), private :: tensor_names_ - type(training_data_file_names_t), private :: training_data_file_names_ contains - generic :: operator(==) => default_real_equals , double_precision_equals - procedure, private :: default_real_equals , double_precision_equals - generic :: to_json => default_real_to_json , double_precision_to_json - procedure, private :: default_real_to_json , double_precision_to_json - generic :: mini_batches => default_real_mini_batches , double_precision_mini_batches - procedure, private :: default_real_mini_batches , double_precision_mini_batches - generic :: optimizer_name => default_real_optimizer_name , double_precision_optimizer_name - procedure, private :: default_real_optimizer_name , double_precision_optimizer_name - generic :: learning_rate => default_real_learning_rate , double_precision_learning_rate - procedure, private :: default_real_learning_rate , double_precision_learning_rate - generic :: activation => default_real_activation , double_precision_activation - procedure, private :: default_real_activation , double_precision_activation - generic :: nodes_per_layer => default_real_nodes_per_layer , double_precision_nodes_per_layer - procedure, private :: default_real_nodes_per_layer , double_precision_nodes_per_layer - generic :: skip_connections => default_real_skip_connections, double_precision_skip_connections - procedure, private :: default_real_skip_connections, double_precision_skip_connections - generic :: input_variable_names => default_real_input_names , double_precision_input_names - procedure, private :: default_real_input_names , double_precision_input_names - generic :: output_variable_names => default_real_output_names , double_precision_output_names - procedure, private :: default_real_output_names , double_precision_output_names - generic :: input_file_names => default_real_input_file_names , double_precision_input_file_names - procedure, private :: default_real_input_file_names , double_precision_input_file_names - generic :: output_file_names => default_real_output_file_names , double_precision_output_file_names - procedure, private :: default_real_output_file_names , double_precision_output_file_names - generic :: time_data_file_name => default_real_time_data_file_name, double_precision_time_data_file_name - procedure, private :: default_real_time_data_file_name, double_precision_time_data_file_name + generic :: operator(==) => default_real_equals , double_precision_equals + procedure, private :: default_real_equals , double_precision_equals + generic :: to_json => default_real_to_json , double_precision_to_json + procedure, private :: default_real_to_json , double_precision_to_json + generic :: mini_batches => default_real_mini_batches , double_precision_mini_batches + procedure, private :: default_real_mini_batches , double_precision_mini_batches + generic :: optimizer_name => default_real_optimizer_name , double_precision_optimizer_name + procedure, private :: default_real_optimizer_name , double_precision_optimizer_name + generic :: learning_rate => default_real_learning_rate , double_precision_learning_rate + procedure, private :: default_real_learning_rate , double_precision_learning_rate + generic :: activation => default_real_activation , double_precision_activation + procedure, private :: default_real_activation , double_precision_activation + generic :: nodes_per_layer => default_real_nodes_per_layer , double_precision_nodes_per_layer + procedure, private :: default_real_nodes_per_layer , double_precision_nodes_per_layer + generic :: skip_connections => default_real_skip_connections , double_precision_skip_connections + procedure, private :: default_real_skip_connections , double_precision_skip_connections + generic :: input_variable_names => default_real_input_names , double_precision_input_names + procedure, private :: default_real_input_names , double_precision_input_names + generic :: output_variable_names => default_real_output_names, double_precision_output_names + procedure, private :: default_real_output_names, double_precision_output_names end type interface training_configuration_t - pure module function default_real_from_components(hyperparameters, network_configuration, tensor_names, training_data_file_names) & + pure module function default_real_from_components(hyperparameters, network_configuration, tensor_names) & result(training_configuration) implicit none type(hyperparameters_t), intent(in) :: hyperparameters type(network_configuration_t), intent(in) :: network_configuration type(training_configuration_t) training_configuration type(tensor_names_t), intent(in) :: tensor_names - type(training_data_file_names_t), intent(in) :: training_data_file_names end function - pure module function double_precision_from_components(hyperparameters, network_configuration, tensor_names, training_data_file_names) & + pure module function double_precision_from_components(hyperparameters, network_configuration, tensor_names) & result(training_configuration) implicit none type(hyperparameters_t(double_precision)), intent(in) :: hyperparameters type(network_configuration_t), intent(in) :: network_configuration type(tensor_names_t), intent(in) :: tensor_names type(training_configuration_t(double_precision)) training_configuration - type(training_data_file_names_t), intent(in) :: training_data_file_names end function module function default_real_from_file(file_object) result(training_configuration) @@ -207,42 +197,6 @@ pure module function double_precision_output_names(self) result(output_names) type(string_t), allocatable :: output_names(:) end function - pure module function default_real_input_file_names(self) result(names) - implicit none - class(training_configuration_t), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function double_precision_input_file_names(self) result(names) - implicit none - class(training_configuration_t(double_precision)), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function default_real_output_file_names(self) result(names) - implicit none - class(training_configuration_t), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function double_precision_output_file_names(self) result(names) - implicit none - class(training_configuration_t(double_precision)), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function default_real_time_data_file_name(self) result(name) - implicit none - class(training_configuration_t), intent(in) :: self - type(string_t) name - end function - - pure module function double_precision_time_data_file_name(self) result(name) - implicit none - class(training_configuration_t(double_precision)), intent(in) :: self - type(string_t) name - end function - end interface end module diff --git a/src/fiats/training_configuration_s.F90 b/src/fiats/training_configuration_s.F90 index 980d188d9..112325401 100644 --- a/src/fiats/training_configuration_s.F90 +++ b/src/fiats/training_configuration_s.F90 @@ -1,4 +1,4 @@ -! Copyright (c), The Regents of the University of California +! Copyright (c) 2023-2025, The Regents of the University of California ! Terms of use are as specified in LICENSE.txt submodule(training_configuration_m) training_configuration_s use double_precision_string_m, only : double_precision_string_t @@ -14,7 +14,6 @@ training_configuration%hyperparameters_ = hyperparameters training_configuration%network_configuration_ = network_configuration training_configuration%tensor_names_ = tensor_names - training_configuration%training_data_file_names_ = training_data_file_names training_configuration%file_t = file_t([ & string_t(header), & @@ -23,8 +22,6 @@ training_configuration%network_configuration_%to_json(), & string_t(separator), & training_configuration%tensor_names_%to_json(), & - string_t(separator), & - training_configuration%training_data_file_names_%to_json(), & string_t(footer) & ]) @@ -35,7 +32,6 @@ training_configuration%hyperparameters_ = hyperparameters training_configuration%network_configuration_ = network_configuration training_configuration%tensor_names_ = tensor_names - training_configuration%training_data_file_names_ = training_data_file_names training_configuration%file_t = file_t([ & string_t(header), & @@ -44,57 +40,27 @@ training_configuration%network_configuration_%to_json(), & string_t(separator), & training_configuration%tensor_names_%to_json(), & - string_t(separator), & - training_configuration%training_data_file_names_%to_json(), & string_t(footer) & ]) end procedure module procedure default_real_from_file -#if defined _CRAYFTN - type(string_t), allocatable :: lines(:) -#endif - training_configuration%file_t = file_object -#if defined _CRAYFTN - lines = training_configuration%file_t%lines() -#else associate(lines => training_configuration%file_t%lines()) -#endif - training_configuration%hyperparameters_ = hyperparameters_t(lines) training_configuration%network_configuration_= network_configuration_t(lines) training_configuration%tensor_names_ = tensor_names_t(lines) - training_configuration%training_data_file_names_ = training_data_file_names_t(lines) - -#if ! defined _CRAYFTN end associate -#endif - end procedure module procedure double_precision_from_file -#if defined _CRAYFTN - type(double_precision_string_t), allocatable :: lines(:) -#endif - training_configuration%double_precision_file_t = file_object - -#if defined _CRAYFTN - lines = training_configuration%double_precision_file_t%double_precision_lines() -#else associate(lines => training_configuration%double_precision_file_t%double_precision_lines()) -#endif - training_configuration%hyperparameters_ = hyperparameters_t(lines) training_configuration%network_configuration_= network_configuration_t(lines) training_configuration%tensor_names_ = tensor_names_t(lines) - training_configuration%training_data_file_names_ = training_data_file_names_t(lines) - -#if ! defined _CRAYFTN end associate -#endif end procedure module procedure default_real_to_json @@ -109,16 +75,14 @@ lhs_eq_rhs = & lhs%hyperparameters_ == rhs%hyperparameters_ .and. & lhs%network_configuration_ == rhs%network_configuration_ .and. & - lhs%tensor_names_ == rhs%tensor_names_ .and. & - lhs%training_data_file_names_ == rhs%training_data_file_names_ + lhs%tensor_names_ == rhs%tensor_names_ end procedure module procedure double_precision_equals lhs_eq_rhs = & lhs%hyperparameters_ == rhs%hyperparameters_ .and. & lhs%network_configuration_ == rhs%network_configuration_ .and. & - lhs%tensor_names_ == rhs%tensor_names_ .and. & - lhs%training_data_file_names_ == rhs%training_data_file_names_ + lhs%tensor_names_ == rhs%tensor_names_ end procedure module procedure default_real_mini_batches @@ -162,12 +126,7 @@ end procedure module procedure default_real_activation -#if defined _CRAYFTN - type(string_t) :: activation_name - activation_name = self%network_configuration_%activation_name() -#else associate(activation_name => self%network_configuration_%activation_name()) -#endif select case(activation_name%string()) case ("gelu") activation = activation_t(gelu) @@ -180,18 +139,11 @@ case default error stop 'activation_factory_s(factory): unrecognized activation name "' // activation_name%string() // '"' end select -#if ! (defined _CRAYFTN) end associate -#endif end procedure module procedure double_precision_activation -#if defined _CRAYFTN - type(string_t) :: activation_name - activation_name = self%network_configuration_%activation_name() -#else associate(activation_name => self%network_configuration_%activation_name()) -#endif select case(activation_name%string()) case ("gelu") activation = activation_t(gelu) @@ -204,9 +156,7 @@ case default error stop 'activation_factory_s(factory): unrecognized activation name "' // activation_name%string() // '"' end select -#if ! (defined _CRAYFTN) end associate -#endif end procedure module procedure default_real_input_names @@ -225,28 +175,4 @@ output_names = self%tensor_names_%output_names() end procedure - module procedure default_real_input_file_names - names = self%training_data_file_names_%fully_qualified_inputs_files() - end procedure - - module procedure double_precision_input_file_names - names = self%training_data_file_names_%fully_qualified_inputs_files() - end procedure - - module procedure default_real_output_file_names - names = self%training_data_file_names_%fully_qualified_outputs_files() - end procedure - - module procedure double_precision_output_file_names - names = self%training_data_file_names_%fully_qualified_outputs_files() - end procedure - - module procedure default_real_time_data_file_name - name = self%training_data_file_names_%fully_qualified_time_file() - end procedure - - module procedure double_precision_time_data_file_name - name = self%training_data_file_names_%fully_qualified_time_file() - end procedure - end submodule training_configuration_s diff --git a/src/fiats/training_data_file_names_m.f90 b/src/fiats/training_data_file_names_m.f90 deleted file mode 100644 index ab22b1a9e..000000000 --- a/src/fiats/training_data_file_names_m.f90 +++ /dev/null @@ -1,81 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -module training_data_file_names_m - use julienne_string_m, only : string_t - implicit none - - private - public :: training_data_file_names_t - - type training_data_file_names_t - private - character(len=:), allocatable :: path_, inputs_prefix_, outputs_prefix_ - type(string_t), allocatable :: infixes_(:) - contains - procedure :: to_json - procedure :: fully_qualified_inputs_files - procedure :: fully_qualified_outputs_files - procedure :: fully_qualified_time_file - procedure :: path - generic :: operator(==) => equals - procedure, private :: equals - end type - - interface training_data_file_names_t - - pure module function from_json(lines) result(training_data_file_names) - implicit none - class(string_t), intent(in) :: lines(:) - type(training_data_file_names_t) training_data_file_names - end function - - pure module function from_components(path, inputs_prefix, outputs_prefix, infixes) result(training_data_file_names) - implicit none - character(len=*), intent(in) :: path, inputs_prefix, outputs_prefix - type(string_t), intent(in) :: infixes(:) - type(training_data_file_names_t) training_data_file_names - end function - - end interface - - interface - - pure module function path(self) result(training_data_file_path) - implicit none - class(training_data_file_names_t), intent(in) :: self - character(len=:), allocatable :: training_data_file_path - end function - - elemental module function equals(lhs, rhs) result(lhs_eq_rhs) - implicit none - class(training_data_file_names_t), intent(in) :: lhs, rhs - logical lhs_eq_rhs - end function - - pure module function to_json(self) result(lines) - implicit none - class(training_data_file_names_t), intent(in) :: self - type(string_t), allocatable :: lines(:) - end function - - pure module function fully_qualified_inputs_files(self) result(names) - implicit none - class(training_data_file_names_t), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function fully_qualified_outputs_files(self) result(names) - implicit none - class(training_data_file_names_t), intent(in) :: self - type(string_t), allocatable :: names(:) - end function - - pure module function fully_qualified_time_file(self) result(name) - implicit none - class(training_data_file_names_t), intent(in) :: self - type(string_t) name - end function - - end interface - -end module diff --git a/src/fiats/training_data_file_names_s.F90 b/src/fiats/training_data_file_names_s.F90 deleted file mode 100644 index 13e2ed559..000000000 --- a/src/fiats/training_data_file_names_s.F90 +++ /dev/null @@ -1,85 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt - -#include "assert_macros.h" - -submodule(training_data_file_names_m) training_data_file_names_s - use assert_m - use julienne_m, only : operator(.csv.) - implicit none - - character(len=*), parameter :: training_data_file_names_key = "training data file names" - character(len=*), parameter :: path_key = "path" - character(len=*), parameter :: inputs_prefix_key = "inputs prefix" - character(len=*), parameter :: outputs_prefix_key = "outputs prefix" - character(len=*), parameter :: infixes_key = "infixes" - character(len=*), parameter :: suffix = ".nc" - -contains - - module procedure path - training_data_file_path = self%path_ - end procedure - - module procedure fully_qualified_time_file - name = self%path_ // "/dt.json" - end procedure - - module procedure to_json - character(len=*), parameter :: indent = repeat(" ",ncopies=4) - - lines = [ & - string_t(indent // '"' //training_data_file_names_key // '": {' ) & - ,string_t(indent // indent // '"' // path_key // '" : "' // self%path_ // '",') & - ,string_t(indent // indent // '"' // inputs_prefix_key // '" : "' // self%inputs_prefix_ // '",') & - ,string_t(indent // indent // '"' // outputs_prefix_key // '" : "' // self%outputs_prefix_ // '",') & - , indent // indent // '"infixes" : [' // .csv. self%infixes_%bracket('"') // '],' & - ,string_t(indent // '}' ) & - ] - end procedure - - module procedure from_json - integer l - logical training_data_file_names_key_found - - training_data_file_names_key_found = .false. - - do l=1,size(lines) - if (lines(l)%get_json_key() == training_data_file_names_key) then - training_data_file_names_key_found = .true. - training_data_file_names%path_ = lines(l+1)%get_json_value(string_t(path_key), mold=string_t("")) // "/" - training_data_file_names%inputs_prefix_ = lines(l+2)%get_json_value(string_t(inputs_prefix_key), mold=string_t("")) - training_data_file_names%outputs_prefix_ = lines(l+3)%get_json_value(string_t(outputs_prefix_key), mold=string_t("")) - training_data_file_names%infixes_ = lines(l+4)%get_json_value(string_t(infixes_key), mold=[string_t("")]) - return - end if - end do - - call_assert(training_data_file_names_key_found) - end procedure - - module procedure from_components - training_data_file_names%path_ = path - training_data_file_names%inputs_prefix_ = inputs_prefix - training_data_file_names%outputs_prefix_ = outputs_prefix - training_data_file_names%infixes_ = infixes - end procedure - - module procedure equals - lhs_eq_rhs = lhs%path_ == rhs%path_ & - .and. lhs%inputs_prefix_ == rhs%inputs_prefix_ & - .and. lhs%outputs_prefix_ == rhs%outputs_prefix_ & - .and. all(lhs%infixes_ == rhs%infixes_) - end procedure - - module procedure fully_qualified_inputs_files - integer i - names = [(self%path_ // "/" // self%inputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] - end procedure - - module procedure fully_qualified_outputs_files - integer i - names = [(self%path_ // "/" // self%outputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] - end procedure - -end submodule training_data_file_names_s diff --git a/test/main.F90 b/test/main.F90 index 46889303a..55982480b 100644 --- a/test/main.F90 +++ b/test/main.F90 @@ -14,7 +14,7 @@ program main use tensor_map_test_m, only : tensor_map_test_t use tensor_names_test_m, only : tensor_names_test_t use tensor_test_m, only : tensor_test_t - use training_data_file_names_test_m, only : training_data_file_names_test_t + use training_data_files_test_m, only : training_data_files_test_t use julienne_m, only : command_line_t implicit none @@ -28,7 +28,7 @@ program main type(tensor_map_test_t) tensor_map_test type(tensor_names_test_t) tensor_names_test type(tensor_test_t) tensor_test - type(training_data_file_names_test_t) training_data_file_names_test + type(training_data_files_test_t) training_data_files_test real t_start, t_finish integer :: passes=0, tests=0 @@ -58,7 +58,7 @@ program main call asymmetric_network_test%report(passes, tests) call neural_network_test%report(passes, tests) call trainable_network_test%report(passes, tests) - call training_data_file_names_test%report(passes, tests) + call training_data_files_test%report(passes, tests) call cpu_time(t_finish) print * diff --git a/test/training_data_file_names_test_m.F90 b/test/training_data_file_names_test_m.F90 deleted file mode 100644 index a40deb902..000000000 --- a/test/training_data_file_names_test_m.F90 +++ /dev/null @@ -1,73 +0,0 @@ -! Copyright (c), The Regents of the University of California -! Terms of use are as specified in LICENSE.txt -module training_data_file_names_test_m - !! Test training_data_file_names_t object I/O and construction - - ! External dependencies - use fiats_m, only : training_data_file_names_t - use julienne_m, only : test_t, test_result_t, test_description_t, test_description_substring, string_t, file_t -#if ! defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) - use julienne_m, only : test_function_i -#endif - - ! Internal dependencies - use training_data_file_names_m, only : training_data_file_names_t - - implicit none - - private - public :: training_data_file_names_test_t - - type, extends(test_t) :: training_data_file_names_test_t - contains - procedure, nopass :: subject - procedure, nopass :: results - end type - -contains - - pure function subject() result(specimen) - character(len=:), allocatable :: specimen - specimen = "A training_data_file_names_t object" - end function - - function results() result(test_results) - type(test_description_t), allocatable :: test_descriptions(:) - type(test_result_t), allocatable :: test_results(:) - -#if defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) - test_descriptions = [ & - test_description_t( string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip) & - ] -#else - procedure(test_function_i), pointer :: check_json_round_trip_ptr - check_json_round_trip_ptr => check_json_round_trip - - test_descriptions = [ & - test_description_t(string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip_ptr) & - ] -#endif - associate( & - substring_in_subject => index(subject(), test_description_substring) /= 0, & - substring_in_description => test_descriptions%contains_text(string_t(test_description_substring)) & - ) - test_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_description) - end associate - test_results = test_descriptions%run() - end function - - function check_json_round_trip() result(test_passes) - logical test_passes - associate(training_data_file_names => training_data_file_names_t( & - path = "dates-20101001-2011076" & - ,inputs_prefix = "training_input-image-" & - ,outputs_prefix = "training_output-image-" & - ,infixes = string_t(["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"]) & - )) - associate(from_json => training_data_file_names_t(training_data_file_names%to_json())) - test_passes = training_data_file_names == from_json - end associate - end associate - end function - -end module training_data_file_names_test_m From 3f83c8b108a8b1154c34baadaf2fecbf6213834a Mon Sep 17 00:00:00 2001 From: Damian Rouson Date: Tue, 15 Apr 2025 10:20:10 -0700 Subject: [PATCH 22/22] fix(CI): add training_data_files_* --- demo/training_data_files.json | 8 +++ src/fiats/training_data_files_m.f90 | 81 +++++++++++++++++++++++++++ src/fiats/training_data_files_s.F90 | 85 +++++++++++++++++++++++++++++ test/training_data_files_test_m.F90 | 73 +++++++++++++++++++++++++ 4 files changed, 247 insertions(+) create mode 100644 demo/training_data_files.json create mode 100644 src/fiats/training_data_files_m.f90 create mode 100644 src/fiats/training_data_files_s.F90 create mode 100644 test/training_data_files_test_m.F90 diff --git a/demo/training_data_files.json b/demo/training_data_files.json new file mode 100644 index 000000000..5b85bf348 --- /dev/null +++ b/demo/training_data_files.json @@ -0,0 +1,8 @@ + { + "training data files": { + "path" : "dates-20101001-2011076", + "inputs prefix" : "training_input-image-", + "outputs prefix" : "training_output-image-", + "infixes" : ["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"] + } + } diff --git a/src/fiats/training_data_files_m.f90 b/src/fiats/training_data_files_m.f90 new file mode 100644 index 000000000..a9df271d5 --- /dev/null +++ b/src/fiats/training_data_files_m.f90 @@ -0,0 +1,81 @@ +! Copyright (c) 2023-2025, The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module training_data_files_m + use julienne_string_m, only : string_t + implicit none + + private + public :: training_data_files_t + + type training_data_files_t + private + character(len=:), allocatable :: path_, inputs_prefix_, outputs_prefix_ + type(string_t), allocatable :: infixes_(:) + contains + procedure :: to_json + procedure :: fully_qualified_inputs_files + procedure :: fully_qualified_outputs_files + procedure :: fully_qualified_time_file + procedure :: path + generic :: operator(==) => equals + procedure, private :: equals + end type + + interface training_data_files_t + + pure module function from_json(lines) result(training_data_files) + implicit none + class(string_t), intent(in) :: lines(:) + type(training_data_files_t) training_data_files + end function + + pure module function from_components(path, inputs_prefix, outputs_prefix, infixes) result(training_data_files) + implicit none + character(len=*), intent(in) :: path, inputs_prefix, outputs_prefix + type(string_t), intent(in) :: infixes(:) + type(training_data_files_t) training_data_files + end function + + end interface + + interface + + pure module function path(self) result(training_data_file_path) + implicit none + class(training_data_files_t), intent(in) :: self + character(len=:), allocatable :: training_data_file_path + end function + + elemental module function equals(lhs, rhs) result(lhs_eq_rhs) + implicit none + class(training_data_files_t), intent(in) :: lhs, rhs + logical lhs_eq_rhs + end function + + pure module function to_json(self) result(lines) + implicit none + class(training_data_files_t), intent(in) :: self + type(string_t), allocatable :: lines(:) + end function + + pure module function fully_qualified_inputs_files(self) result(names) + implicit none + class(training_data_files_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function fully_qualified_outputs_files(self) result(names) + implicit none + class(training_data_files_t), intent(in) :: self + type(string_t), allocatable :: names(:) + end function + + pure module function fully_qualified_time_file(self) result(name) + implicit none + class(training_data_files_t), intent(in) :: self + type(string_t) name + end function + + end interface + +end module diff --git a/src/fiats/training_data_files_s.F90 b/src/fiats/training_data_files_s.F90 new file mode 100644 index 000000000..fd2a83d2c --- /dev/null +++ b/src/fiats/training_data_files_s.F90 @@ -0,0 +1,85 @@ +! Copyright (c) 2023-2025, The Regents of the University of California +! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + +submodule(training_data_files_m) training_data_files_s + use assert_m + use julienne_m, only : operator(.csv.) + implicit none + + character(len=*), parameter :: training_data_files_key = "training data files" + character(len=*), parameter :: path_key = "path" + character(len=*), parameter :: inputs_prefix_key = "inputs prefix" + character(len=*), parameter :: outputs_prefix_key = "outputs prefix" + character(len=*), parameter :: infixes_key = "infixes" + character(len=*), parameter :: suffix = ".nc" + +contains + + module procedure path + training_data_file_path = self%path_ + end procedure + + module procedure fully_qualified_time_file + name = self%path_ // "/dt.json" + end procedure + + module procedure to_json + character(len=*), parameter :: indent = repeat(" ",ncopies=4) + + lines = [ & + string_t(indent // '"' //training_data_files_key // '": {' ) & + ,string_t(indent // indent // '"' // path_key // '" : "' // self%path_ // '",') & + ,string_t(indent // indent // '"' // inputs_prefix_key // '" : "' // self%inputs_prefix_ // '",') & + ,string_t(indent // indent // '"' // outputs_prefix_key // '" : "' // self%outputs_prefix_ // '",') & + , indent // indent // '"infixes" : [' // .csv. self%infixes_%bracket('"') // ']' & + ,string_t(indent // '}' ) & + ] + end procedure + + module procedure from_json + integer l + logical training_data_files_key_found + + training_data_files_key_found = .false. + + do l=1,size(lines) + if (lines(l)%get_json_key() == training_data_files_key) then + training_data_files_key_found = .true. + training_data_files%path_ = lines(l+1)%get_json_value(string_t(path_key), mold=string_t("")) + training_data_files%inputs_prefix_ = lines(l+2)%get_json_value(string_t(inputs_prefix_key), mold=string_t("")) + training_data_files%outputs_prefix_ = lines(l+3)%get_json_value(string_t(outputs_prefix_key), mold=string_t("")) + training_data_files%infixes_ = lines(l+4)%get_json_value(string_t(infixes_key), mold=[string_t("")]) + return + end if + end do + + call_assert(training_data_files_key_found) + end procedure + + module procedure from_components + training_data_files%path_ = path + training_data_files%inputs_prefix_ = inputs_prefix + training_data_files%outputs_prefix_ = outputs_prefix + training_data_files%infixes_ = infixes + end procedure + + module procedure equals + lhs_eq_rhs = lhs%path_ == rhs%path_ & + .and. lhs%inputs_prefix_ == rhs%inputs_prefix_ & + .and. lhs%outputs_prefix_ == rhs%outputs_prefix_ & + .and. all(lhs%infixes_ == rhs%infixes_) + end procedure + + module procedure fully_qualified_inputs_files + integer i + names = [(self%path_ // "/" // self%inputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] + end procedure + + module procedure fully_qualified_outputs_files + integer i + names = [(self%path_ // "/" // self%outputs_prefix_ //self%infixes_(i) // suffix, i=1, size(self%infixes_))] + end procedure + +end submodule training_data_files_s diff --git a/test/training_data_files_test_m.F90 b/test/training_data_files_test_m.F90 new file mode 100644 index 000000000..a62abe7dd --- /dev/null +++ b/test/training_data_files_test_m.F90 @@ -0,0 +1,73 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module training_data_files_test_m + !! Test training_data_files_t object I/O and construction + + ! External dependencies + use fiats_m, only : training_data_files_t + use julienne_m, only : test_t, test_result_t, test_description_t, test_description_substring, string_t, file_t +#if ! defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) + use julienne_m, only : test_function_i +#endif + + ! Internal dependencies + use training_data_files_m, only : training_data_files_t + + implicit none + + private + public :: training_data_files_test_t + + type, extends(test_t) :: training_data_files_test_t + contains + procedure, nopass :: subject + procedure, nopass :: results + end type + +contains + + pure function subject() result(specimen) + character(len=:), allocatable :: specimen + specimen = "A training_data_files_t object" + end function + + function results() result(test_results) + type(test_description_t), allocatable :: test_descriptions(:) + type(test_result_t), allocatable :: test_results(:) + +#if defined(HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY) + test_descriptions = [ & + test_description_t( string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip) & + ] +#else + procedure(test_function_i), pointer :: check_json_round_trip_ptr + check_json_round_trip_ptr => check_json_round_trip + + test_descriptions = [ & + test_description_t(string_t("round-trip to/from JSON yielding equivalent objects"), check_json_round_trip_ptr) & + ] +#endif + associate( & + substring_in_subject => index(subject(), test_description_substring) /= 0, & + substring_in_description => test_descriptions%contains_text(string_t(test_description_substring)) & + ) + test_descriptions = pack(test_descriptions, substring_in_subject .or. substring_in_description) + end associate + test_results = test_descriptions%run() + end function + + function check_json_round_trip() result(test_passes) + logical test_passes + associate(training_data_files => training_data_files_t( & + path = "dates-20101001-2011076" & + ,inputs_prefix = "training_input-image-" & + ,outputs_prefix = "training_output-image-" & + ,infixes = string_t(["000001", "000002", "000003", "000004", "000005", "000006", "000007", "000008", "000009", "000010"]) & + )) + associate(from_json => training_data_files_t(training_data_files%to_json())) + test_passes = training_data_files == from_json + end associate + end associate + end function + +end module training_data_files_test_m