Feature: read/write/test ICAR time step data

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"}

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

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

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 *

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