Merge pull request #73 from BerkeleyLab/read-training-data

Add app that reads training data from ICAR output

app/train-cloud-microphysics.f90

@@ -0,0 +1,85 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+#ifndef __INTEL_FORTRAN
+!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro
+!! effectively eliminates this file's source code when building with an Intel compiler.
+program train_cloud_microphysics
+  !! Train a neural network to represent the simplest cloud microphysics model from
+  !! the Intermediate Complexity Atmospheric Research Model (ICAR) at
+  !! https://github.com/BerkeleyLab/icar.
+  use sourcery_m, only : string_t, file_t, command_line_t
+  use NetCDF_file_m, only : NetCDF_file_t
+  implicit none
+
+  type(command_line_t) command_line
+  character(len=:), allocatable :: base
+
+  base = command_line%flag_value("--base-name") ! gfortran 13 seg faults if this is an association
+
+  if (len(base)==0) error stop new_line('a') // new_line('a') // &
+    'Usage: ./build/run-fpm.sh run train-cloud-microphysics -- --base-name "<file-base-name>"'
+
+  associate(network_input => base // "_input.nc", network_output => base // "_output.nc", network => base // "_network.json")
+
+    read_and_train: &
+    block
+      real, allocatable, dimension(:,:,:,:) :: pressure_in, potential_temperature_in, temperature_in, &
+                                               qv_in, qc_in, qi_in, qr_in, qs_in
+      real, allocatable, dimension(:,:,:,:) :: pressure_out, potential_temperature_out, temperature_out, &
+                                               qv_out, qc_out, qi_out, qr_out, qs_out
+      real, allocatable, dimension(:,:,:) :: precipitation_in, snowfall_in
+      real, allocatable, dimension(:,:,:) :: precipitation_out, snowfall_out
+      real time_in, time_out
+
+      associate(network_input_file => netCDF_file_t(network_input))
+        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("precipitation", precipitation_in)
+        call network_input_file%input("snowfall", snowfall_in)
+        call network_input_file%input("qv", qv_in)
+        call network_input_file%input("qc", qc_in)
+        call network_input_file%input("qi", qi_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)
+      end associate
+
+      associate(network_output_file => netCDF_file_t(network_output))
+        call network_output_file%input("pressure", pressure_out)
+        call network_output_file%input("potential_temperature", potential_temperature_out)
+        call network_output_file%input("temperature", temperature_out)
+        call network_output_file%input("precipitation", precipitation_out)
+        call network_output_file%input("snowfall", snowfall_out)
+        call network_output_file%input("qv", qv_out)
+        call network_output_file%input("qc", qc_out)
+        call network_output_file%input("qi", qi_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)
+      end associate
+
+      associate(dt => time_out - time_in)
+        associate( &
+          dp_dt => (pressure_out - pressure_in)/dt, &
+          dpt_dt => (potential_temperature_out - potential_temperature_in)/dt, &
+          dtemp_dt => (temperature_out - temperature_in)/dt, &
+          dprecip_dt => (precipitation_out - precipitation_in)/dt, &
+          dsnow_dt => (snowfall_out - snowfall_in)/dt, &
+          dqv_dt => (qv_out - qv_in)/dt, &
+          dqc_dt => (qc_out - qc_in)/dt, &
+          dqi_dt => (qi_out - qi_in)/dt, &
+          dqr_dt => (qr_out - qr_in)/dt, &
+          dqs_dt => (qs_out - qs_in)/dt  &
+        )
+        end associate
+      end associate
+
+    end block read_and_train
+
+  end associate
+
+  print *,new_line('a') // "______training_cloud_microhpysics done _______"
+
+end program train_cloud_microphysics
+#endif // __INTEL_FORTRAN

fpm.toml

@@ -5,6 +5,6 @@ author = "Damian Rouson, Tan Nguyen, Jordan Welsman"
 maintainer = "rouson@lbl.gov"
 
 [dependencies]
-assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.4.0"}
+assert = {git = "https://github.com/sourceryinstitute/assert", tag = "1.5.0"}
 sourcery = {git = "https://github.com/sourceryinstitute/sourcery", tag = "3.8.2"}
 netcdf-interfaces = {git = "https://github.com/rouson/netcdf-interfaces.git", branch = "implicit-interfaces"}

src/inference_engine/NetCDF_file_m.f90

@@ -0,0 +1,63 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+#ifndef __INTEL_FORTRAN
+!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro
+!! effectively eliminates this file's source code when building with an Intel compiler.
+module NetCDF_file_m
+  implicit none
+
+  private
+  public :: NetCDF_file_t
+
+  type NetCDF_file_t
+    private
+    character(len=:), allocatable :: file_name_
+  contains
+    procedure :: input_2D_integer, input_4D_real, input_3D_real, input_real_scalar
+    generic :: input => input_2D_integer, input_4D_real, input_3D_real, input_real_scalar
+  end type
+
+  interface NetCDF_file_t
+
+    pure module function construct(file_name) result(NetCDF_file)
+      implicit none
+      character(len=*), intent(in) :: file_name
+      type(NetCDF_file_t) NetCDF_file
+    end function
+
+  end interface
+
+  interface
+
+    module subroutine input_real_scalar(self, varname, scalar)
+      implicit none
+      class(NetCDF_file_t), intent(in) :: self
+      character(len=*), intent(in) :: varname
+      real, intent(out) :: scalar
+    end subroutine
+
+    module subroutine input_2D_integer(self, varname, values)
+      implicit none
+      class(NetCDF_file_t), intent(in) :: self
+      character(len=*), intent(in) :: varname
+      integer, intent(out), allocatable :: values(:,:)
+    end subroutine
+
+    module subroutine input_4D_real(self, varname, values)
+      implicit none
+      class(NetCDF_file_t), intent(in) :: self
+      character(len=*), intent(in) :: varname
+      real, intent(out), allocatable :: values(:,:,:,:)
+    end subroutine
+
+    module subroutine input_3D_real(self, varname, values)
+      implicit none
+      class(NetCDF_file_t), intent(in) :: self
+      character(len=*), intent(in) :: varname
+      real, intent(out), allocatable :: values(:,:,:)
+    end subroutine
+
+  end interface
+
+end module NetCDF_file_m
+#endif // __INTEL_FORTRAN

src/inference_engine/NetCDF_file_s.f90

@@ -0,0 +1,157 @@
+! Copyright (c), The Regents of the University of California
+! Terms of use are as specified in LICENSE.txt
+#ifndef __INTEL_FORTRAN
+!! Due to a suspected bug in the Intel ifx compiler, the above C preprocessor macro
+!! effectively eliminates this file's source code when building with an Intel compiler.
+submodule(netCDF_file_m) netCDF_file_s
+  use netcdf, only : &
+     nf90_create, nf90_def_dim, nf90_def_var, nf90_enddef, nf90_put_var, nf90_inquire_dimension, & ! functions
+     nf90_close, nf90_open, nf90_inq_varid, nf90_get_var, nf90_inquire_variable, &
+     nf90_clobber, nf90_noerr, nf90_strerror, nf90_int, nf90_nowrite ! constants
+  use assert_m, only : assert, intrinsic_array_t
+  implicit none
+
+contains
+
+  module procedure construct
+   netCDF_file%file_name_ = file_name
+  end procedure
+
+  function get_shape(ncid, varname) result(array_shape)
+    implicit none
+    character(len=*), intent(in) :: varname
+    integer, intent(in) :: ncid
+    integer, allocatable :: array_shape(:)
+    character(len=32) varid_string
+    integer varid, dimlen, i, var_rank
+    integer, parameter :: max_rank=15
+    integer,dimension(max_rank+1) :: dims, dimIds
+    associate(nf_status => nf90_inq_varid(ncid, varname, varid))
+      write(varid_string, *) varid
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inq_varid " // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string)))
+    end associate
+    associate(nf_status => nf90_inquire_variable(ncid, varid, ndims = var_rank))
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), &
+        trim(nf90_strerror(nf_status)) // "(" // varname // ")")
+    end associate
+    associate(nf_status => nf90_inquire_variable(ncid, varid, dimids = dimIds(:var_rank)))
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_variable" // trim(nf90_strerror(nf_status)), &
+        trim(nf90_strerror(nf_status)) // "(" // varname // ")")
+    end associate
+    do i=1,var_rank
+      associate(nf_status => nf90_inquire_dimension(ncid, dimIds(i), len = dimlen))
+        call assert(nf_status == nf90_noerr, "Net_CDF_file_m(get_shape): nf90_inquire_dimension" // trim(nf90_strerror(nf_status)),&
+          trim(nf90_strerror(nf_status)) // "(" // varname // ")")
+      end associate
+      dims(i+1)=dimlen
+    end do
+    array_shape = dims(2:var_rank+1)
+  end function 
+
+  module procedure input_real_scalar
+
+    character(len=32) varid_string
+    integer ncid, varid
+
+    associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces
+      call assert(nf_status == nf90_noerr, &
+        "Net_CDF_file_m(input_real_scalar): nf90_open" // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_)
+    end associate
+
+    associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID
+      write(varid_string, *) varid
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_real_scalar): nf90_inq_varid " // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string)))
+    end associate
+
+    associate( nf_status => nf90_get_var(ncid, varid, scalar)) ! read data
+      call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_real_scalar): nf90_get_var", trim(nf90_strerror(nf_status)))
+    end associate
+
+  end procedure
+
+  module procedure input_2D_integer
+
+    character(len=32) varid_string
+    integer ncid, varid
+
+    associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces
+      call assert(nf_status == nf90_noerr, &
+        "Net_CDF_file_m(input_2D_integer): nf90_open" // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = trim(nf90_strerror(nf_status)) // self%file_name_)
+    end associate
+
+    associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID
+      write(varid_string, *) varid
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_2D_integer): nf90_inq_varid " // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string)))
+    end associate
+
+    associate(array_shape => get_shape(ncid, varname))
+      call assert(size(array_shape)==rank(values), "netCDF_file_s(input_2D_integer): size(array_shape)==rank(values)")
+      allocate(values(array_shape(1), array_shape(2)))
+      associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data
+        call assert(nf_status == nf90_noerr, "NetCDF_file_s(input_2D_integer): nf90_get_var", trim(nf90_strerror(nf_status)))
+      end associate
+    end associate
+
+  end procedure
+
+  module procedure input_4D_real
+
+    character(len=32) varid_string
+    integer ncid, varid
+
+    associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces
+      call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", &
+        trim(nf90_strerror(nf_status)) // self%file_name_)
+    end associate
+
+    associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID
+      write(varid_string, *) varid
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_4D_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string)))
+    end associate
+
+    associate(array_shape => get_shape(ncid, varname))
+      call assert(size(array_shape)==rank(values), "netCDF_file_s(input_4D_real): size(array_shape)==rank(values)", &
+        intrinsic_array_t([size(array_shape),rank(values)]))
+      allocate(values(array_shape(1), array_shape(2), array_shape(3), array_shape(4)))
+      associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data
+        call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status)))
+      end associate
+    end associate
+
+  end procedure
+
+  module procedure input_3D_real
+
+    character(len=32) varid_string
+    integer ncid, varid
+
+    associate( nf_status => nf90_open(self%file_name_, nf90_nowrite, ncid) ) ! open file with read-only acces
+      call assert(nf_status == nf90_noerr, "nf90_open(self%file_name_, NF90_NOWRITE, ncid)", &
+        trim(nf90_strerror(nf_status)) // self%file_name_)
+    end associate
+
+    associate( nf_status => nf90_inq_varid(ncid, varname, varid)) ! get variable's ID
+      write(varid_string, *) varid
+      call assert(nf_status == nf90_noerr, "Net_CDF_file_m(input_3D_real): nf90_inq_varid " // trim(nf90_strerror(nf_status)), &
+        diagnostic_data = "varname '" // varname // "', varid " // trim(adjustl(varid_string)))
+    end associate
+
+    associate(array_shape => get_shape(ncid, varname))
+      call assert(size(array_shape)==rank(values), "netCDF_file_s(input_3D_real): size(array_shape)==rank(values)", &
+        intrinsic_array_t([size(array_shape),rank(values)]))
+      allocate(values(array_shape(1), array_shape(2), array_shape(3)))
+      associate( nf_status => nf90_get_var(ncid, varid, values)) ! read data
+        call assert(nf_status == nf90_noerr, "nf90_get_var(ncid, varid, array)", trim(nf90_strerror(nf_status)))
+      end associate
+    end associate
+
+  end procedure
+
+end submodule netCDF_file_s
+#endif // __INTEL_FORTRAN