Serialization and get/set value functions for NOAH-OWP-MODULAR

INSTALL.md

@@ -4,13 +4,14 @@ This release of Noah-OWP-Modular comes with example forcing data and a namelist
 
 ## Configure
 
-Noah-OWP-Modular presently requires only one external library: [NetCDF](https://www.unidata.ucar.edu/software/netcdf/). You can install NetCDF using the link or through a package manager such as [Brew](https://brew.sh/). Once NetCDF is installed, you can configure the model. The first step is to set up a configuration file. There are currently 4 build options in the `config` directory:
+Noah-OWP-Modular presently requires only one external library: [NetCDF](https://www.unidata.ucar.edu/software/netcdf/). You can install NetCDF using the link or through a package manager such as [Brew](https://brew.sh/). Once NetCDF is installed, you can configure the model. The first step is to set up a configuration file. There are currently 6 build options in the `config` directory:
 
 - `user_build_options.cheyenne`: Cheyenne supercomputer
 - `user_build_options.pgf90.linux`: Linux with pgf90 compiler, NetCDF installed via source (usr/local)
 - `user_build_options.macos.gfortran`: MacOS with gfortran compiler, NetCDF installed via source (opt/local)
 - `user_build_options.bigsur.gfortran`: MacOS Big Sur with gfortran compiler, NetCDF 4.8.0 installed via Brew (** this is the current tesiting environment **)
 - `user_build_options.gfortran.linux`: Linux with gfortran compiler, NetCDF installed via module. The $NETCDF environmental variable is defined, such as NOAA Hera.
+- 'user_build_options.gfortran.ubuntu': Ubuntu with gfortran compiler, NetCDF installed from package
 
 If your system does not match one of the above options, you'll need to edit one of the files or create your own. If you do the latter, you'll need to add another option to the `configure` Perl script.
 

bmi/bmi_noahowp.f90

@@ -620,6 +620,9 @@ function noahowp_var_type(this, name, type) result (bmi_status)
     character (len=*), intent(in) :: name
     character (len=*), intent(out) :: type
     integer :: bmi_status
+    character(len=BMI_MAX_TYPE_NAME) :: ser_create = "uint64" !pads spaces upto 2048.
+    character(len=BMI_MAX_TYPE_NAME) :: ser_state = "character" !pads spaces upto 2048
+    character(len=BMI_MAX_TYPE_NAME) :: ser_free = "int" !pads spaces upto 2048
 
     select case(name)
     case('ACSNOM', 'AXAJ', 'BEXP', 'BXAJ', 'CMC', 'CWP', 'DKSAT',          &
@@ -634,6 +637,15 @@ function noahowp_var_type(this, name, type) result (bmi_status)
     case('ISNOW')
        type = "integer"
        bmi_status = BMI_SUCCESS
+    case ('serialization_create')
+       type = ser_create
+       bmi_status = BMI_SUCCESS
+    case ('serialization_state')
+       type = ser_state
+       bmi_status = BMI_SUCCESS
+    case ('serialization_free')
+       type = ser_free
+       bmi_status = BMI_SUCCESS
     case default
        type = "-"
        bmi_status = BMI_FAILURE
@@ -875,20 +887,37 @@ function noahowp_var_nbytes(this, name, nbytes) result (bmi_status)
     integer :: bmi_status
     integer :: s1, s2, s3, grid, grid_size, item_size
 
-    s1 = this%get_var_grid(name, grid)
-    s2 = this%get_grid_size(grid, grid_size)
-    s3 = this%get_var_itemsize(name, item_size)
-
-    if (grid .eq. 0) then
-       nbytes = item_size
-       bmi_status = BMI_SUCCESS
-    else if ((s1 == BMI_SUCCESS).and.(s2 == BMI_SUCCESS).and.(s3 == BMI_SUCCESS)) then
-       nbytes = item_size * grid_size
-       bmi_status = BMI_SUCCESS
+    if (name == "serialization_create") then
+      nbytes = storage_size(0_int64)/8 !returns size in bits. So, divide by 8 for bytes.
+      bmi_status = BMI_SUCCESS
+    else if (name == "serialization_state") then
+      if(.not.allocated(this%model%serialization_buffer) .or. size(this%model%serialization_buffer) == 0) then
+         nbytes = -1
+         call write_log("Serialization not set yet!", LOG_LEVEL_WARNING)
+         bmi_status = BMI_FAILURE
+      else
+         nbytes = size(this%model%serialization_buffer,KIND=int64)
+         bmi_status = BMI_SUCCESS
+      end if
+    else if (name == "serialization_free") then 
+      nbytes = storage_size(0_int32)/8 !returns size in bits. So, divide by 8 for bytes.
+      bmi_status = BMI_SUCCESS
     else
-       nbytes = -1
-       bmi_status = BMI_FAILURE
-       call write_log("bmi:noahowp_var_nbytes: invalid var " // name // ". nbytes value set to '-1'", LOG_LEVEL_WARNING)
+      s1 = this%get_var_grid(name, grid)
+      s2 = this%get_grid_size(grid, grid_size)
+      s3 = this%get_var_itemsize(name, item_size)
+
+      if (grid .eq. 0) then
+        nbytes = item_size
+        bmi_status = BMI_SUCCESS
+      else if ((s1 == BMI_SUCCESS).and.(s2 == BMI_SUCCESS).and.(s3 == BMI_SUCCESS)) then
+        nbytes = item_size * grid_size
+        bmi_status = BMI_SUCCESS
+      else
+        nbytes = -1
+        bmi_status = BMI_FAILURE
+        call write_log("bmi:noahowp_var_nbytes: invalid var " // name // ". nbytes value set to '-1'", LOG_LEVEL_WARNING)
+      end if
     end if
   end function noahowp_var_nbytes
 
@@ -921,6 +950,14 @@ function noahowp_get_int(this, name, dest) result (bmi_status)
     case("ISNOW")
        dest(:) = this%model%water%ISNOW
        bmi_status = BMI_SUCCESS
+    case("serialization_size")
+        if(.not.allocated(this%model%serialization_buffer) .or. size(this%model%serialization_buffer) == 0) then
+            call write_log("Serialization not set yet!", LOG_LEVEL_WARNING)
+            bmi_status = BMI_FAILURE
+        else
+            dest = size(this%model%serialization_buffer,KIND=int64)
+            bmi_status = BMI_SUCCESS
+         end if
     case default
        dest(:) = -1
        bmi_status = BMI_FAILURE
@@ -1125,9 +1162,12 @@ function noahowp_get_ptr_int(this, name, dest_ptr) result (bmi_status)
      integer :: n_elements
 
      select case(name)
-     case default
-        bmi_status = BMI_FAILURE
-        call write_log("bmi:noahowp_get_ptr_int: invalid var " // name, LOG_LEVEL_WARNING)
+      case("serialization_state")
+          dest_ptr = this%model%serialization_buffer
+          bmi_status = BMI_SUCCESS
+      case default
+          bmi_status = BMI_FAILURE
+          call write_log("bmi:noahowp_get_ptr_int: invalid var " // name, LOG_LEVEL_WARNING)
      end select
    end function noahowp_get_ptr_int
 
@@ -1237,14 +1277,32 @@ function noahowp_set_int(this, name, src) result (bmi_status)
     character (len=*), intent(in) :: name
     integer, intent(in) :: src(:)
     integer :: bmi_status
+    integer(kind=int64) :: exec_status
 
     !==================== UPDATE IMPLEMENTATION IF NECESSARY FOR INTEGER VARS =================
 
     select case(name)
 !     case("model__identification_number")
 !        this%model%id = src(1)
 !        bmi_status = BMI_SUCCESS
-    case default
+      case("serialization_create")
+         call new_serialization_request(this%model, exec_status)
+         if (exec_status == 0) then
+            bmi_status = BMI_SUCCESS
+            call write_log("Serialization for state saving complete", LOG_LEVEL_INFO)
+         else
+            bmi_status = BMI_FAILURE
+            call write_log(" Failed to create serialized data for state saving", LOG_LEVEL_FATAL) 
+         end if
+      case("serialization_state")
+         call deserialize_mp_buffer(this%model,src)
+         bmi_status = BMI_SUCCESS
+      case("serialization_free")
+         if(allocated(this%model%serialization_buffer)) then
+            deallocate(this%model%serialization_buffer)
+         end if
+         bmi_status = BMI_SUCCESS
+      case default
        bmi_status = BMI_FAILURE
        call write_log("bmi:noahowp_set_int: invalid var " // name, LOG_LEVEL_WARNING)
     end select

run/Makefile

@@ -41,6 +41,11 @@ OBJS = \
         ../src/EnergyModule.o \
         ../src/UtilitiesModule.o \
         ../src/DateTimeUtilsModule.o \
+        ../src/byte_utilities.o \
+        ../src/messagepack_value.o \
+        ../src/messagepack_user.o \
+        ../src/messagepack.o \
+        ../src/StateSerialization.o \
         ../src/RunModule.o \
         ../driver/OutputModule.o \
         ../driver/NoahModularDriver.o \

src/Makefile

@@ -41,6 +41,11 @@ OBJS = noahowpLogger.o \
        EnergyModule.o \
        UtilitiesModule.o \
        DateTimeUtilsModule.o \
+       byte_utilities.o \
+       messagepack_value.o \
+       messagepack_user.o \
+       messagepack.o \
+       StateSerialization.o \
        RunModule.o
 
 all:	$(OBJS)
@@ -107,8 +112,13 @@ EnergyModule.o: OptionsType.o LevelsType.o DomainType.o ParametersType.o EnergyT
                 ForcingType.o WaterType.o ThermalPropertiesModule.o ShortwaveRadiationModule.o \
                 PrecipHeatModule.o EtFluxModule.o SnowSoilTempModule.o
 UtilitiesModule.o: DomainType.o ForcingType.o EnergyType.o
+messagepack_value.o: byte_utilities.o
+messagepack_user.o: byte_utilities.o messagepack_value.o
+messagepack.o: byte_utilities.o messagepack_value.o messagepack_user.o
+StateSerialization.o: DomainType.o ParametersType.o EnergyType.o \
+                ForcingType.o WaterType.o messagepack.o
 RunModule.o: OptionsType.o LevelsType.o DomainType.o ParametersType.o EnergyType.o \
                 ForcingType.o WaterType.o NamelistRead.o ../driver/AsciiReadModule.o \
                 ../driver/OutputModule.o UtilitiesModule.o ForcingModule.o InterceptionModule.o \
-                EnergyModule.o WaterModule.o DateTimeUtilsModule.o
+                EnergyModule.o WaterModule.o DateTimeUtilsModule.o messagepack.o StateSerialization.o
 

src/RunModule.f90

@@ -18,6 +18,10 @@ module RunModule
   use EnergyModule
   use WaterModule
   use DateTimeUtilsModule
+  use noahowp_log_module
+  use StateSerialization
+  use messagepack
+  use iso_fortran_env
 
   implicit none
   type :: noahowp_type
@@ -29,6 +33,7 @@ module RunModule
     type(water_type)      :: water
     type(forcing_type)    :: forcing
     type(energy_type)     :: energy
+    byte, dimension(:), allocatable :: serialization_buffer
   end type noahowp_type
 contains
 
@@ -237,7 +242,12 @@ SUBROUTINE cleanup(model)
 #ifndef NGEN_OUTPUT_ACTIVE
       call finalize_output()
 #endif
-
+    !Free up serialization buffer memory
+    if(allocated(model%serialization_buffer)) then
+      deallocate(model%serialization_buffer)
+    end if
+
+
   END SUBROUTINE cleanup
 
   !== Move the model ahead one time step ================================================================
@@ -327,4 +337,98 @@ SUBROUTINE solve_noahowp(model)
     end associate ! terminate associate block
   END SUBROUTINE solve_noahowp
 
+  SUBROUTINE new_serialization_request (model, exec_status)
+    type(noahowp_type), intent(inout) :: model
+    class(msgpack), allocatable :: mp
+    class(mp_arr_type), allocatable :: mp_sub_arr
+    class(mp_arr_type), allocatable :: mp_arr
+    byte, dimension(:), allocatable :: serialization_buffer
+    integer(kind=int64), intent(out) :: exec_status
+
+    mp = msgpack()
+    mp_arr = mp_arr_type(5) !forcing, domain, energy,water, parameters
+
+    call forcing_serialization(model%forcing,mp_sub_arr)
+    mp_arr%values(1)%obj = mp_sub_arr !forcing
+    deallocate(mp_sub_arr)
+
+    call energy_serialization(model%energy,mp_sub_arr)
+    mp_arr%values(2)%obj = mp_sub_arr !energy
+    deallocate(mp_sub_arr)
+
+    call domain_serialization(model%domain,mp_sub_arr)
+    mp_arr%values(3)%obj = mp_sub_arr !domain
+    deallocate(mp_sub_arr)
+
+    call water_serialization(model%water,mp_sub_arr)
+    mp_arr%values(4)%obj = mp_sub_arr !water
+    deallocate(mp_sub_arr)
+
+    call parameters_serialization(model%parameters,mp_sub_arr)
+    mp_arr%values(5)%obj = mp_sub_arr !parameters
+    deallocate(mp_sub_arr)
+
+    ! pack the data
+    call mp%pack_alloc(mp_arr, serialization_buffer)
+    if (mp%failed()) then
+        call write_log("Serialization using messagepack failed!. Error:" // mp%error_message, LOG_LEVEL_FATAL)
+        exec_status = 1
+    else
+        exec_status = 0
+        model%serialization_buffer = serialization_buffer
+        call write_log("Serialization using messagepack successful!", LOG_LEVEL_INFO)
+    end if
+  END SUBROUTINE new_serialization_request
+
+  SUBROUTINE deserialize_mp_buffer (model, serialized_data)
+    type(noahowp_type), intent(inout) :: model
+    integer , intent(in) :: serialized_data(:)
+    byte, allocatable :: serialized_data_1b(:)
+    class(mp_value_type), allocatable :: mpv
+    class(msgpack), allocatable :: mp
+    class(mp_arr_type), allocatable :: arr_all
+    class(mp_arr_type), allocatable :: arr
+    logical :: error, status
+    integer(kind=int64) :: index
+
+    mp = msgpack()
+    !convert integer(4) to integer(1) for messagepack
+    serialized_data_1b = TRANSFER(serialized_data, serialized_data_1b)
+    call mp%unpack(serialized_data_1b, mpv)
+    if (is_arr(mpv)) then
+      call get_arr_ref(mpv, arr_all, status) 
+      if (status) then
+        !The number of elements in the serialized data array is expected to be 5. Check here and stop if they are not equal.
+        if (mpv%numelements() .NE. 5) then
+          call write_log("The serialized data does not contain all state information. Please check inputs", LOG_LEVEL_FATAL)
+          stop
+        end if
+
+        do index=1,5
+          call get_arr_ref(arr_all%values(index)%obj,arr,status)
+          if(status) then
+            select case(index)
+              case(1)
+                call forcing_deserialization (arr, model%forcing)
+              case(2)  
+                call energy_deserialization (arr, model%energy)
+              case(3)
+                call domain_deserialization (arr, model%domain)
+              case(4)
+                call water_deserialization (arr, model%water)
+              case(5)
+                call parameters_deserialization (arr, model%parameters)
+            end select
+          else
+            call write_log("Serialization using messagepack (internal array) failed!. Error:" // mp%error_message, LOG_LEVEL_FATAL)
+          end if
+        end do
+      else
+        call write_log("Serialization using messagepack (external array) failed!. Error:" // mp%error_message, LOG_LEVEL_FATAL)
+      end if
+    end if
+    deallocate (mpv)
+
+  END SUBROUTINE deserialize_mp_buffer
+
 end module RunModule