diff --git a/demo/fpm.toml b/demo/fpm.toml index 01aa82e17..bde6b9b7b 100644 --- a/demo/fpm.toml +++ b/demo/fpm.toml @@ -5,6 +5,6 @@ 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.5.3"} +julienne = {git = "https://github.com/berkeleylab/julienne", tag = "1.8.0"} fiats = {path = "../"} netcdf-interfaces = {git = "https://github.com/LKedward/netcdf-interfaces.git", rev = "d2bbb71ac52b4e346b62572b1ca1620134481096"} diff --git a/demo/src/time_data_m.F90 b/demo/src/time_data_m.F90 new file mode 100644 index 000000000..bc5acd068 --- /dev/null +++ b/demo/src/time_data_m.F90 @@ -0,0 +1,84 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt +module time_data_m + use kind_parameters_m, only : default_real + use julienne_m, only : file_t, string_t + implicit none + + private + public :: time_data_t + public :: icar_output_file_t + + type time_data_t!(k) + !! encapsulate separately saved ICAR time stamps and steps + !integer, kind :: k = default_real + type(string_t), allocatable, private :: date_(:), time_(:) + real, allocatable, private :: dt_(:) + !real(k), allocatable :: dt_(:) + contains + generic :: to_json => default_real_to_json + procedure, private :: default_real_to_json + generic :: dt => default_real_dt + procedure, private :: default_real_dt + end type + + type, extends(file_t) :: icar_output_file_t + end type + + interface time_data_t + + pure module function default_real_from_json(file) result(time_data) + implicit none + type(file_t), intent(in) :: file + type(time_data_t) time_data + end function + + pure module function default_real_from_strings(date, time, dt) result(time_data) + implicit none + type(string_t), intent(in) :: date(:), time(:) + real, intent(in) :: dt(:) + type(time_data_t) time_data + end function + + pure module function default_real_from_characters(date, time, dt) result(time_data) + implicit none + character(len=*), intent(in) :: date(:), time(:) + real, intent(in) :: dt(:) + type(time_data_t) time_data + end function + + pure module function from_icar_output(icar_output_file) result(time_data) + implicit none + type(icar_output_file_t), intent(in) :: icar_output_file + type(time_data_t) time_data + end function + + end interface + + interface icar_output_file_t + + pure module function from_string_array(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 + + pure module function default_real_to_json(self) result(file) + implicit none + class(time_data_t), intent(in) :: self + type(file_t) file + end function + + pure module function default_real_dt(self) result(dt_values) + implicit none + class(time_data_t), intent(in) :: self + real, allocatable :: dt_values(:) + 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 new file mode 100644 index 000000000..127041664 --- /dev/null +++ b/demo/src/time_data_s.F90 @@ -0,0 +1,124 @@ +! Copyright (c), The Regents of the University of California +! Terms of use are as specified in LICENSE.txt + +#include "assert_macros.h" + +submodule(time_data_m) time_data_s + use assert_m + use julienne_m, only : separated_values, operator(.csv.) + implicit none +contains + + module procedure from_string_array + icar_output_file%file_t = file_t(lines) + end procedure + + module procedure default_real_from_json + + integer i + + 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%date_ = 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 + time_data%date_ = date + time_data%time_ = time + time_data%dt_ = dt + end procedure + + module procedure default_real_from_characters + time_data%date_ = string_t(date) + time_data%time_ = string_t(time) + time_data%dt_ = dt + end procedure + + module procedure from_icar_output + associate(lines => icar_output_file%lines()) + block + integer line + integer, parameter :: space = 1, date_length = len("2010/10/01"), time_length = len("03:16:00") + character(len=*), parameter :: preface = " training data dt=" + integer, parameter :: preface_end = len(preface) + integer, parameter :: date_start = preface_end + space + 1, date_end = date_start + date_length - 1 + integer, parameter :: time_start = date_end + space + 1, time_end = time_start + time_length - 1 + integer, parameter :: dt_start = time_end + space + 1 + + associate(num_lines => size(lines)) + + 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) + time_data%date_(line) = raw_line(date_start:date_end) + time_data%time_(line) = raw_line(time_start:time_end) + read(raw_line(dt_start:),*) time_data%dt_(line) + end associate + end do + + end associate + end block + end associate + end procedure + + module procedure default_real_to_json + integer, parameter :: characters_per_value=17, comma = 1 + character(len=*), parameter :: indent = repeat(" ",ncopies=12) + character(len=:), allocatable :: csv_format, date_string, time_string, dt_string + + call_assert(allocated(self%date_)) + call_assert(allocated(self%time_)) + call_assert(allocated(self%dt_)) + call_assert(all(size(self%date_) == [size(self%time_), size(self%dt_)])) + + associate( & + quoted_dates => self%date_%bracket('"') & + ,quoted_times => self%time_%bracket('"') & + ) + csv_format = separated_values(separator="','", mold=[real::]) + allocate(character(len=size(self%date_)*(len('"2010/10/01"' )+comma))::date_string) + allocate(character(len=size(self%time_)*(len('"03:16:00"')+comma))::time_string) + allocate(character(len=size(self%dt_)*(characters_per_value+1)-1)::dt_string) + associate( & + csv_dates => .csv. quoted_dates & + ,csv_times => .csv. quoted_times & + ,csv_dt => .csv. string_t(self%dt_) & + ) + write(date_string, fmt = csv_format) csv_dates%string() + write(time_string, fmt = csv_format) csv_times%string() + write( dt_string, fmt = csv_format) csv_dt%string() + file = file_t([ & + string_t('{'), & + string_t(' "time_data" : {'), & + string_t(indent // ' "dates": [' // trim(adjustl(date_string)) // '],'), & + string_t(indent // ' "times": [' // trim(adjustl(time_string)) // '],'), & + string_t(indent // ' "dt": [' // trim(adjustl(dt_string)) // ']'), & + string_t(indent // '}'), & + string_t('}') & + ] ) + end associate + end associate + end procedure + + module procedure default_real_dt + dt_values = self%dt_ + end procedure + +end submodule time_data_s diff --git a/demo/test/main.F90 b/demo/test/main.F90 index 142657420..603817b4a 100644 --- a/demo/test/main.F90 +++ b/demo/test/main.F90 @@ -5,12 +5,14 @@ program main use netCDF_file_test_m, only : netCDF_file_test_t + use time_data_test_m, only : time_data_test_t use iso_fortran_env, only : int64, real64 use julienne_m, only : command_line_t implicit none integer(int64) t_start, t_finish, clock_rate type(netCDF_file_test_t) netCDF_file_test + type(time_data_test_t) time_data_test integer :: passes=0, tests=0 print_usage_if_help_requested: & @@ -28,6 +30,7 @@ program main call system_clock(t_start, clock_rate) call netCDF_file_test%report(passes, tests) + call time_data_test%report(passes, tests) call system_clock(t_finish) print * diff --git a/demo/test/time_data_test_m.F90 b/demo/test/time_data_test_m.F90 new file mode 100644 index 000000000..39b78fba9 --- /dev/null +++ b/demo/test/time_data_test_m.F90 @@ -0,0 +1,110 @@ +! Copyright (c) 2022-2024, The Regents of the University of California and Sourcery Institute +! Terms of use are as specified in LICENSE.txt + +#include "language-support.F90" + +module time_data_test_m + !! Unit test for the time_data subroutine + use julienne_m, only : & + file_t & + ,operator(.csv.) & + ,string_t & + ,test_t & + ,test_result_t & + ,test_description_t & + ,test_diagnosis_t & + ,test_description_substring +#if ! HAVE_PROCEDURE_ACTUAL_FOR_POINTER_DUMMY + use julienne_m, only : diagnosis_function_i +#endif + use time_data_m, only : time_data_t, icar_output_file_t + implicit none + + private + public :: time_data_test_t + + type, extends(test_t) :: time_data_test_t + contains + procedure, nopass :: subject + procedure, nopass :: results + end type + +contains + + pure function subject() result(specimen) + character(len=:), allocatable :: specimen + specimen = "The time_data_t type" + end function + + function results() result(test_results) + type(test_result_t), allocatable :: test_results(:) + type(test_description_t), allocatable :: test_descriptions(:) + +#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("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 + + construct_from_icar_file_ptr => construct_from_icar_file + write_then_read_json_ptr => write_then_read_json + + test_descriptions = [ & + test_description_t("constructing a instance from a file object in the icar output format", construct_from_icar_file_ptr) & + ,test_description_t("writing and reading a JSON file returns the values written", write_then_read_json_ptr) & + ] +#endif + + test_descriptions = pack(test_descriptions, & + index(subject(), test_description_substring) /= 0 & + .or. test_descriptions%contains_text(test_description_substring)) + + test_results = test_descriptions%run() + end function + + function construct_from_icar_file() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + + real, parameter :: expected_dt = 120., tolerance = 1E-08 + 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 " & + ] ) ) ) ) + associate(dt => time_data%dt()) + test_diagnosis = test_diagnosis_t( & + test_passed = all(abs(dt - expected_dt) < tolerance) & + ,diagnostics_string = "expected " // string_t(expected_dt) // ", actual " // .csv. string_t(dt) & + ) + end associate + end associate + end function + + function write_then_read_json() result(test_diagnosis) + type(test_diagnosis_t) test_diagnosis + type(time_data_t) time_data + real, parameter :: expected_dt = 120.000000, tolerance = 1.E-08 + + 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] & + ) ) + associate(json_file => time_data%to_json()) + associate(from_json => time_data_t(json_file)) + associate(actual_dt => from_json%dt()) + test_diagnosis = test_diagnosis_t( & + test_passed = all(abs(actual_dt - expected_dt) < tolerance) & + ,diagnostics_string = "expected " & // string_t(expected_dt) // ", actual " & // string_t(actual_dt) & + ) + end associate + end associate + end associate + end associate + end function + +end module time_data_test_m