Add radiator from NetCDF file

docs/source/user_guide.rst

@@ -721,6 +721,52 @@ the provided units that is present in the list of
 These profiles should describe the concentration of
 the constituent on the ``height`` grid.
 
+
+From NetCDF file
+~~~~~~~~~~~~~~~~
+This radiator type allows loading the optical properties of
+a radiator from a NetCDF file. The optical properties will
+remain constant throughout the calculations.
+
+.. code-block:: JSON
+
+    {
+      "name": "foo",
+      "type": "from netcdf file",
+      "file path": "path/to/file.nc"
+    }
+
+
+============================    ==============
+keys                            Required/Optional
+============================    ==============
+``name``                        required
+``type``                        required
+``file path``                   required 
+============================    ==============
+
+The ``file path`` should be a string containing the absolute
+or relative path to the NetCDF file containing the optical
+properties.
+
+The NetCDF file should be structured as follows::
+
+   dimensions:
+      heights = NUMBER_OF_VERTICAL_LAYERS ;
+      wavelengths = NUMBER_OF_WAVELENGTH_BINS ;
+   variables:
+      double optical_depth(wavelengths, heights) ;
+      double single_scattering_albedo(wavelengths, heights) ;
+      double asymmetry_factor(wavelengths, heights) ;
+
+
+The ``NUMBER_OF_VERTICAL_LAYERS`` and ``NUMBER_OF_WAVELENGTH_BINS``
+must correspond to the number of bins in the ``height`` and
+``wavelength`` grids specified in the TUV-x configuration file.
+(Note that these optical properties are per grid section and not at
+grid edges.) No interpolation is performed on this data set.
+
+
 Aerosols
 ~~~~~~~~
 A special radiator type exists for aerosols, which
@@ -762,7 +808,7 @@ keys                            Required/Optional
 ``enable diagnostics``          optional
 ============================    ==============
 
-The regressoin tests compare the new version of TUV-x to the old version. One
+The regression tests compare the new version of TUV-x to the old version. One
 way is by directly comparing output. The `enable diagnostics` allows for this
 ouptut to be disabled. If this is enabled, a folder named `output` will be 
 created in the same directory TUV-x is run from.

src/radiative_transfer/radiator_factory.F90

@@ -8,6 +8,7 @@ module tuvx_radiator_factory
   use tuvx_radiator,                   only : radiator_t
   use tuvx_radiator_aerosol,           only : radiator_aerosol_t
   use tuvx_radiator_from_host,         only : radiator_from_host_t
+  use tuvx_radiator_from_netcdf_file,  only : radiator_from_netcdf_file_t
 
   implicit none
 
@@ -49,6 +50,9 @@ function radiator_builder( config, grid_warehouse, profile_warehouse,       &
       case( 'aerosol' )
         new_radiator => radiator_aerosol_t( config, grid_warehouse,           &
                                             profile_warehouse )
+      case( 'from netcdf file' )
+        new_radiator => radiator_from_netcdf_file_t( config, grid_warehouse,  &
+                                                     profile_warehouse )
       case default
         call die_msg( 460768245, "Invalid radiator type: '"//                 &
                                  radiator_type%to_char()//"'" )
@@ -73,6 +77,8 @@ type(string_t) function radiator_type_name( radiator ) result( name )
         name = "radiator_aerosol_t"
       type is( radiator_from_host_t )
         name = "radiator_from_host_t"
+      type is( radiator_from_netcdf_file_t )
+        name = "radiator_from_netcdf_file_t"
       class default
         call die( 365718517 )
     end select
@@ -99,6 +105,8 @@ function radiator_allocate( type_name ) result( radiator )
         allocate( radiator_aerosol_t :: radiator )
       case( 'radiator_from_host_t' )
         allocate( radiator_from_host_t :: radiator )
+      case( 'radiator_from_netcdf_file_t' )
+        allocate( radiator_from_netcdf_file_t :: radiator )
       case default
         call die_msg( 670539061, "Invalid radiator type: '"//                 &
                                  type_name//"'" )

src/radiative_transfer/radiators/CMakeLists.txt

@@ -5,6 +5,7 @@ target_sources(tuvx_object
   PRIVATE
     aerosol.F90
     from_host.F90
+    from_netcdf_file.F90
 )
 
 ################################################################################

src/radiative_transfer/radiators/from_netcdf_file.F90

@@ -0,0 +1,116 @@
+! Copyright (C) 2023 National Center for Atmospheric Research
+! SPDX-License-Identifier: Apache-2.0
+module tuvx_radiator_from_netcdf_file
+
+  use musica_constants,                only : dk => musica_dk
+  use musica_string,                   only : string_t
+  use tuvx_radiator,                   only : radiator_t
+
+  implicit none
+
+  private
+  public :: radiator_from_netcdf_file_t
+
+  !> User-specified radiator
+  !!
+  !! User-specified radiators have fixed optical properties that are read
+  !! in from a NetCDF file.
+  type, extends(radiator_t) :: radiator_from_netcdf_file_t
+  contains
+    !> Update the radiator for new environmental conditions
+    procedure :: update_state
+  end type radiator_from_netcdf_file_t
+
+  !> User-specified radiator constructor
+  interface radiator_from_netcdf_file_t
+    module procedure constructor
+  end interface radiator_from_netcdf_file_t
+
+contains
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !> Initialize a user-specified radiator
+  function constructor( config, grid_warehouse, profile_warehouse )           &
+      result ( this )
+
+    use musica_assert,                 only : assert_msg
+    use musica_config,                 only : config_t
+    use musica_string,                 only : string_t
+    use tuvx_grid,                     only : grid_t
+    use tuvx_grid_warehouse,           only : grid_warehouse_t
+    use musica_io_netcdf,              only : io_netcdf_t
+    use tuvx_profile_warehouse,        only : profile_warehouse_t
+
+    class(radiator_from_netcdf_file_t), pointer       :: this ! The constructor radiator
+    type(config_t),                     intent(inout) :: config ! configuration for the radiator
+    type(grid_warehouse_t),             intent(inout) :: grid_warehouse ! Configured grids
+    type(profile_warehouse_t),          intent(inout) :: profile_warehouse ! Configured profiles
+
+    character(len=*),  parameter :: Iam =                                     &
+                                    "radiator from NetCDF file constructor"
+    class(grid_t), pointer :: heights, wavelengths
+    type(string_t) :: file_path, variable
+    type(io_netcdf_t), pointer :: netcdf_file
+    real(kind=dk), allocatable :: temp_G(:,:)
+    integer :: i_wl, i_height
+    type(string_t) :: required_keys(3), optional_keys(0)
+
+    required_keys(1) = "type"
+    required_keys(2) = "name"
+    required_keys(3) = "file path"
+    call assert_msg( 723245326,                                               &
+                     config%validate( required_keys, optional_keys ),         &
+                     "Bad configuration data format for radiator from NetCDF" )
+
+    allocate(this)
+
+    call config%get( "name", this%handle_, Iam )
+    call config%get( "type", this%type_,   Iam )
+
+    heights => grid_warehouse%get_grid( "height", "km" )
+    wavelengths => grid_warehouse%get_grid( "wavelength", "nm" )
+
+    allocate( this%state_%layer_OD_(  heights%ncells_, wavelengths%ncells_ ) )
+    allocate( this%state_%layer_SSA_( heights%ncells_, wavelengths%ncells_ ) )
+    allocate( this%state_%layer_G_( heights%ncells_, wavelengths%ncells_, 1 ) )
+    allocate( temp_G( heights%ncells_, wavelengths%ncells_ ) )
+
+    call config%get( "file path", file_path, Iam )
+    netcdf_file => io_netcdf_t( file_path, read_only = .true. )
+    variable = "optical_depth"
+    call netcdf_file%read_2D_double( variable, this%state_%layer_OD_,  Iam )
+    variable = "single_scattering_albedo"
+    call netcdf_file%read_2D_double( variable, this%state_%layer_SSA_, Iam )
+    variable = "asymmetry_factor"
+    call netcdf_file%read_2D_double( variable, temp_G, Iam )
+    this%state_%layer_G_(:,:,1) = temp_G(:,:)
+
+    deallocate( netcdf_file )
+    deallocate( heights )
+    deallocate( wavelengths )
+
+  end function constructor
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  !> Update the radiator state for current conditions
+  subroutine update_state( this, grid_warehouse, profile_warehouse,           &
+      cross_section_warehouse )
+
+    use tuvx_cross_section_warehouse,  only : cross_section_warehouse_t
+    use tuvx_grid_warehouse,           only : grid_warehouse_t
+    use tuvx_profile_warehouse,        only : profile_warehouse_t
+
+    class(radiator_from_netcdf_file_t), intent(inout) :: this ! Radiator to update
+    type(grid_warehouse_t),             intent(inout) :: grid_warehouse ! Current grids
+    type(profile_warehouse_t),          intent(inout) :: profile_warehouse ! Current profiles
+    type(cross_section_warehouse_t),    intent(inout) :: cross_section_warehouse ! Current cross-sections
+
+    ! nothing to update - radiator properties for this type are fixed
+
+  end subroutine update_state
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+end module tuvx_radiator_from_netcdf_file

test/data/radiators.from_netcdf_file.config.json

@@ -0,0 +1,23 @@
+{
+  "grids": [
+    {
+      "name" : "height",
+      "type" : "from config file",
+      "units" : "km",
+      "values" : [ 0.0, 10.0, 20.0, 30.0 ]
+    },
+    {
+      "name" : "wavelength",
+      "type" : "from config file",
+      "units" : "nm",
+      "values" : [ 550.0, 600.0, 650.0, 700.0, 720.0 ]
+    }
+  ],
+  "radiators": [
+    {
+      "name" : "foo",
+      "type" : "from netcdf file",
+      "file path" : "test/data/radiator.nc"
+    }
+  ]
+}

test/unit/radiator/CMakeLists.txt

@@ -9,5 +9,6 @@ include(test_util)
 create_standard_test(NAME radiator SOURCES radiator_core.F90
                                            radiator_test.F90)
 create_standard_test(NAME radiator_from_host SOURCES from_host.F90)
+create_standard_test(NAME radiator_from_netcdf_file SOURCES from_netcdf_file.F90)
 
 ################################################################################

test/unit/radiator/from_netcdf_file.F90

@@ -0,0 +1,96 @@
+! Copyright (C) 2023 National Center for Atmospheric Research
+! SPDX-License-Identifier: Apache-2.0
+!
+!> \file
+!> Tests the radiator_from_netcdf_file_t type
+program test_radiator_from_netcdf_file
+
+  use musica_constants,                only : dk => musica_dk
+
+  implicit none
+
+  call test_radiator_from_netcdf_file_t()
+
+contains
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  subroutine test_radiator_from_netcdf_file_t( )
+
+    use musica_assert,                 only : assert
+    use musica_config,                 only : config_t
+    use tuvx_grid_warehouse,           only : grid_warehouse_t
+    use tuvx_profile_warehouse,        only : profile_warehouse_t
+    use tuvx_radiator,                 only : radiator_t
+    use tuvx_radiator_warehouse,       only : radiator_warehouse_t
+    use tuvx_cross_section_warehouse,  only : cross_section_warehouse_t
+
+    character(len=*), parameter :: Iam = "radiator_from_netcdf_file_t test"
+    type(config_t) :: config, grid_config, radiator_config
+    type(grid_warehouse_t), pointer :: grids
+    type(profile_warehouse_t), pointer :: profiles
+    type(cross_section_warehouse_t), pointer :: cross_sections
+    type(radiator_warehouse_t), pointer :: radiators
+    class(radiator_t), pointer :: radiator
+
+    call config%from_file( "test/data/radiators.from_netcdf_file.config.json" )
+    call config%get( "grids", grid_config, Iam )
+    call config%get( "radiators", radiator_config, Iam )
+
+    grids => grid_warehouse_t( grid_config )
+    allocate( profiles )
+    allocate( cross_sections )
+    radiators => radiator_warehouse_t( radiator_config, grids, profiles,      &
+                                       cross_sections )
+
+    radiator => radiators%get_radiator( "foo" )
+
+    call assert(459381095, radiator%state_%layer_OD_(1, 1) == 0.0_dk)
+    call assert(219856074, radiator%state_%layer_OD_(1, 2) == 1.0_dk)
+    call assert(949699169, radiator%state_%layer_OD_(1, 3) == 2.0_dk)
+    call assert(162017515, radiator%state_%layer_OD_(1, 4) == 3.0_dk)
+    call assert(556811109, radiator%state_%layer_OD_(2, 1) == 10.0_dk)
+    call assert(669129454, radiator%state_%layer_OD_(2, 2) == 11.0_dk)
+    call assert(216497301, radiator%state_%layer_OD_(2, 3) == 12.0_dk)
+    call assert(946340396, radiator%state_%layer_OD_(2, 4) == 13.0_dk)
+    call assert(493708243, radiator%state_%layer_OD_(3, 1) == 100.0_dk)
+    call assert(323551339, radiator%state_%layer_OD_(3, 2) == 101.0_dk)
+    call assert(153394435, radiator%state_%layer_OD_(3, 3) == 102.0_dk)
+    call assert(330721180, radiator%state_%layer_OD_(3, 4) == 103.0_dk)
+
+    call assert(211685289, radiator%state_%layer_SSA_(1, 1) == 0.1_dk)
+    call assert(258995234, radiator%state_%layer_SSA_(1, 2) == 0.2_dk)
+    call assert(771371480, radiator%state_%layer_SSA_(1, 3) == 0.3_dk)
+    call assert(266165075, radiator%state_%layer_SSA_(1, 4) == 0.4_dk)
+    call assert(996008170, radiator%state_%layer_SSA_(2, 1) == 0.11_dk)
+    call assert(543376017, radiator%state_%layer_SSA_(2, 2) == 0.12_dk)
+    call assert(373219113, radiator%state_%layer_SSA_(2, 3) == 0.13_dk)
+    call assert(203062209, radiator%state_%layer_SSA_(2, 4) == 0.14_dk)
+    call assert(932905304, radiator%state_%layer_SSA_(3, 1) == 0.111_dk)
+    call assert(480273151, radiator%state_%layer_SSA_(3, 2) == 0.112_dk)
+    call assert(375124647, radiator%state_%layer_SSA_(3, 3) == 0.113_dk)
+    call assert(204967743, radiator%state_%layer_SSA_(3, 4) == 0.114_dk)
+
+    call assert(310568542, radiator%state_%layer_G_(1, 1, 1) == 20.0_dk)
+    call assert(422886887, radiator%state_%layer_G_(1, 2, 1) == 19.0_dk)
+    call assert(870254733, radiator%state_%layer_G_(1, 3, 1) == 18.0_dk)
+    call assert(417622580, radiator%state_%layer_G_(1, 4, 1) == 17.0_dk)
+    call assert(247465676, radiator%state_%layer_G_(2, 1, 1) == 10.0_dk)
+    call assert(977308771, radiator%state_%layer_G_(2, 2, 1) == 9.0_dk)
+    call assert(524676618, radiator%state_%layer_G_(2, 3, 1) == 8.0_dk)
+    call assert(354519714, radiator%state_%layer_G_(2, 4, 1) == 7.0_dk)
+    call assert(249371210, radiator%state_%layer_G_(3, 1, 1) == 4.0_dk)
+    call assert(979214305, radiator%state_%layer_G_(3, 2, 1) == 3.0_dk)
+    call assert(809057401, radiator%state_%layer_G_(3, 3, 1) == 2.0_dk)
+    call assert(356425248, radiator%state_%layer_G_(3, 4, 1) == 1.0_dk)
+
+    nullify( radiator )
+    deallocate( radiators )
+    deallocate( cross_sections )
+    deallocate( profiles )
+    deallocate( grids )
+
+  end subroutine test_radiator_from_netcdf_file_t
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+end program test_radiator_from_netcdf_file