Merge pull request #182 from NCAR/122-make-radiator-updatable

Allow TUV-x radiator data to be updated through the API

cmake/dependencies.cmake

@@ -75,7 +75,7 @@ if (MUSICA_ENABLE_TUVX AND MUSICA_BUILD_C_CXX_INTERFACE)
   set(TUVX_INSTALL_INCLUDE_DIR ${MUSICA_INSTALL_INCLUDE_DIR} CACHE STRING "" FORCE)
 
   set_git_default(TUVX_GIT_REPOSITORY https://github.com/NCAR/tuv-x.git)
-  set_git_default(TUVX_GIT_TAG 80f896a0fb591987c2a79209377bd6f599b4fb6f)
+  set_git_default(TUVX_GIT_TAG 674ee1e72853bb44d23c36602fa73c955b2f021d)
 
   FetchContent_Declare(tuvx
     GIT_REPOSITORY ${TUVX_GIT_REPOSITORY}

docker/Dockerfile

@@ -9,7 +9,6 @@ RUN dnf -y update \
         gfortran \
         gdb \
         git \
-        lapack-devel \
         lcov \
         make \
         netcdf-fortran-devel \

docker/Dockerfile.fortran-gcc

@@ -13,7 +13,6 @@ RUN dnf -y update \
     git \
     hdf5-devel \
     json-devel \
-    lapack-devel \
     lcov \
     libcurl-devel \
     m4 \
@@ -38,6 +37,7 @@ RUN cd musica \
     && cmake -S . \
              -B build \
              -D CMAKE_BUILD_TYPE=${BUILD_TYPE} \
+             -D MUSICA_GIT_TAG=${MUSICA_GIT_TAG} \
              -D MUSICA_BUILD_FORTRAN_INTERFACE=ON \
              -D MUSICA_ENABLE_MEMCHECK=ON \
     && cd build \

docker/Dockerfile.fortran-gcc.integration

@@ -14,7 +14,6 @@ RUN dnf -y update \
     git \
     hdf5-devel \
     json-devel \
-    lapack-devel \
     lcov \
     libcurl-devel \
     m4 \

docker/Dockerfile.memcheck

@@ -9,7 +9,6 @@ RUN dnf -y update \
         gfortran \
         gdb \
         git \
-        lapack-devel \
         lcov \
         make \
         netcdf-fortran-devel \

docker/Dockerfile.mpi

@@ -16,7 +16,6 @@ RUN sudo dnf -y install \
         gcc-c++ \
         gfortran \
         git \
-        lapack-devel \
         lcov \
         make \
         netcdf-fortran-devel \

docker/Dockerfile.mpi_openmp

@@ -16,7 +16,6 @@ RUN sudo dnf -y install \
         gcc-c++ \
         gfortran \
         git \
-        lapack-devel \
         lcov \
         make \
         netcdf-fortran-devel \

docker/Dockerfile.openmp

@@ -16,7 +16,6 @@ RUN sudo dnf -y install \
         gcc-c++ \
         gfortran \
         git \
-        lapack-devel \
         lcov \
         make \
         netcdf-fortran-devel \

docker/Dockerfile.python

@@ -9,7 +9,6 @@ RUN dnf -y update \
         gcc-fortran \
         gdb \
         git \
-        lapack-devel \
         make \
         netcdf-fortran-devel \
         pip \

fortran/test/fetch_content_integration/CMakeLists.txt

@@ -116,4 +116,4 @@ if (MUSICA_ENABLE_TUVX)
     copy_tuvx_data_dir ALL ${CMAKE_COMMAND} -E copy_directory
     ${CMAKE_CURRENT_SOURCE_DIR}/../../../build/_deps/tuvx-src/data ${CMAKE_BINARY_DIR}/data
   )
-endif()
+endif()

fortran/test/fetch_content_integration/test_tuvx_api.F90

@@ -3,7 +3,8 @@
 !
 program combined_tuvx_tests
   use iso_c_binding
-  use musica_tuvx, only: tuvx_t, grid_map_t, grid_t, profile_map_t, profile_t
+  use musica_tuvx, only: tuvx_t, grid_map_t, grid_t, profile_map_t, profile_t, &
+                         radiator_map_t, radiator_t
   use musica_util, only: assert, error_t
 
   implicit none
@@ -55,22 +56,36 @@ end subroutine test_tuvx_api_invalid_config
 
   subroutine test_tuvx_solve()
 
-    type(tuvx_t),        pointer :: tuvx
-    type(error_t)                :: error
-    type(grid_map_t),    pointer :: grids
-    character(len=256)           :: config_path
-    type(grid_t),        pointer :: grid
-    type(profile_map_t), pointer :: profiles
-    type(profile_t),     pointer :: profile, profile_copy
-    real*8, dimension(5), target :: edges, edge_values, temp_edge
-    real*8, dimension(4), target :: midpoints, midpoint_values, layer_densities, temp_midpoint
-    real*8                       :: temp_real
+    type(tuvx_t),         pointer    :: tuvx
+    type(error_t)                    :: error
+    character(len=256)               :: config_path
+    type(grid_map_t),     pointer    :: grids
+    type(grid_t),         pointer    :: grid, height_grid, wavelength_grid
+    type(profile_map_t),  pointer    :: profiles
+    type(profile_t),      pointer    :: profile, profile_copy
+    type(radiator_map_t), pointer    :: radiators
+    type(radiator_t),     pointer    :: radiator, radiator_copy
+    real*8, dimension(5), target     :: edges, edge_values, temp_edge
+    real*8, dimension(4), target     :: midpoints, midpoint_values, layer_densities, temp_midpoint
+    real*8                           :: temp_real
+    integer                          :: num_vertical_layers, num_wavelength_bins
+    real*8, dimension(3,2), target   :: optical_depths, temp_od
+    real*8, dimension(3,2), target   :: single_scattering_albedos, temp_ssa
+    real*8, dimension(3,2,1), target :: asymmetry_factors, temp_asym
 
     edges = (/ 1.0, 2.0, 3.0, 4.0, 5.0 /)
     midpoints = (/ 15.0, 25.0, 35.0, 45.0 /)  
     edge_values = (/ 10.0, 20.0, 30.0, 40.0, 50.0 /)
     midpoint_values = (/ 15.0, 25.0, 35.0, 45.0 /)
     layer_densities = (/ 2.0, 4.0, 1.0, 7.0 /)
+    num_vertical_layers = 3
+    num_wavelength_bins = 2
+    optical_depths(:,1) = (/ 30.0, 20.0, 10.0 /)
+    optical_depths(:,2) = (/ 70.0, 80.0, 90.0 /)
+    single_scattering_albedos(:,1) = (/ 300.0, 200.0, 100.0 /)
+    single_scattering_albedos(:,2) = (/ 700.0, 800.0, 900.0 /)
+    asymmetry_factors(:,1,1) = (/ 3.0, 2.0, 1.0 /)
+    asymmetry_factors(:,2,1) = (/ 7.0, 8.0, 9.0 /)
 
     config_path = "examples/ts1_tsmlt.json"
 
@@ -312,12 +327,146 @@ subroutine test_tuvx_solve()
     ASSERT_EQ( temp_edge(3), 36.0 )
     ASSERT_EQ( temp_edge(4), 38.0 )
     ASSERT_EQ( temp_edge(5), 40.0 )
-
+
+    radiators => tuvx%get_radiators( error )
+    ASSERT( error%is_success() )
+
+    radiator => radiators%get( "foo_radiator", error )
+    ASSERT( .not. error%is_success() )
+    deallocate( radiator )
+    deallocate( radiators )
+
+    radiators =>radiator_map_t( error )
+    ASSERT( error%is_success() )
+
+    height_grid => grid_t( "height", "km", num_vertical_layers, error )
+    wavelength_grid => grid_t( "wavelength", "nm", num_wavelength_bins, error )
+    radiator => radiator_t( "foo_radiator", height_grid, wavelength_grid, error )
+    ASSERT( error%is_success() )
+
+    call radiator%set_optical_depths( optical_depths, error )
+    ASSERT( error%is_success() )
+
+    call radiator%get_optical_depths( temp_od, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( temp_od(1,1), 30.0 )
+    ASSERT_EQ( temp_od(2,1), 20.0 )
+    ASSERT_EQ( temp_od(3,1), 10.0 )
+    ASSERT_EQ( temp_od(1,2), 70.0 )
+    ASSERT_EQ( temp_od(2,2), 80.0 )
+    ASSERT_EQ( temp_od(3,2), 90.0 )
+
+    call radiator%set_single_scattering_albedos( single_scattering_albedos, error )
+    ASSERT( error%is_success() )
+
+    call radiator%get_single_scattering_albedos( temp_ssa, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( temp_ssa(1,1), 300.0 )
+    ASSERT_EQ( temp_ssa(2,1), 200.0 )
+    ASSERT_EQ( temp_ssa(3,1), 100.0 )
+    ASSERT_EQ( temp_ssa(1,2), 700.0 )
+    ASSERT_EQ( temp_ssa(2,2), 800.0 )
+    ASSERT_EQ( temp_ssa(3,2), 900.0 )
+
+    call radiator%set_asymmetry_factors( asymmetry_factors, error )
+    ASSERT( error%is_success() )
+
+    call radiator%get_asymmetry_factors( temp_asym, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( temp_asym(1,1,1), 3.0 )
+    ASSERT_EQ( temp_asym(2,1,1), 2.0 )
+    ASSERT_EQ( temp_asym(3,1,1), 1.0 )
+    ASSERT_EQ( temp_asym(1,2,1), 7.0 )
+    ASSERT_EQ( temp_asym(2,2,1), 8.0 )
+    ASSERT_EQ( temp_asym(3,2,1), 9.0 )
+!
+    call radiators%add( radiator, error )
+    radiator_copy => radiators%get( "foo_radiator", error )
+
+    optical_depths(:,:) = 0.0
+    single_scattering_albedos(:,:) = 0.0
+    asymmetry_factors(:,:,:) = 0.0
+
+    call radiator_copy%get_optical_depths( optical_depths, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( optical_depths(1,1), 30.0 )
+    ASSERT_EQ( optical_depths(2,1), 20.0 )
+    ASSERT_EQ( optical_depths(3,1), 10.0 )
+    ASSERT_EQ( optical_depths(1,2), 70.0 )
+    ASSERT_EQ( optical_depths(2,2), 80.0 )
+    ASSERT_EQ( optical_depths(3,2), 90.0 )
+
+    call radiator_copy%get_single_scattering_albedos( single_scattering_albedos, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( single_scattering_albedos(1,1), 300.0 )
+    ASSERT_EQ( single_scattering_albedos(2,1), 200.0 )
+    ASSERT_EQ( single_scattering_albedos(3,1), 100.0 )
+    ASSERT_EQ( single_scattering_albedos(1,2), 700.0 )
+    ASSERT_EQ( single_scattering_albedos(2,2), 800.0 )
+    ASSERT_EQ( single_scattering_albedos(3,2), 900.0 )
+
+    call radiator_copy%get_asymmetry_factors( asymmetry_factors, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( asymmetry_factors(1,1,1), 3.0 )
+    ASSERT_EQ( asymmetry_factors(2,1,1), 2.0 )
+    ASSERT_EQ( asymmetry_factors(3,1,1), 1.0 )
+    ASSERT_EQ( asymmetry_factors(1,2,1), 7.0 )
+    ASSERT_EQ( asymmetry_factors(2,2,1), 8.0 )
+    ASSERT_EQ( asymmetry_factors(3,2,1), 9.0 )
+
+    optical_depths(:,1) = (/ 90.0, 80.0, 70.0 /)
+    optical_depths(:,2) = (/ 75.0, 85.0, 95.0 /)
+    single_scattering_albedos(:,1) = (/ 900.0, 800.0, 700.0 /)
+    single_scattering_albedos(:,2) = (/ 750.0, 850.0, 950.0 /)
+    asymmetry_factors(:,1,1) = (/ 9.0, 8.0, 7.0 /)
+    asymmetry_factors(:,2,1) = (/ 5.0, 4.0, 3.0 /)
+
+    call radiator_copy%set_optical_depths( optical_depths, error )
+    call radiator_copy%set_single_scattering_albedos( single_scattering_albedos, error )
+    call radiator_copy%set_asymmetry_factors( asymmetry_factors, error )
+    ASSERT( error%is_success() )
+
+    optical_depths(:,:) = 0.0
+    single_scattering_albedos(:,:) = 0.0
+    asymmetry_factors(:,:,:) = 0.0
+
+    call radiator%get_optical_depths( optical_depths, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( optical_depths(1,1), 90.0 )
+    ASSERT_EQ( optical_depths(2,1), 80.0 )
+    ASSERT_EQ( optical_depths(3,1), 70.0 )
+    ASSERT_EQ( optical_depths(1,2), 75.0 )
+    ASSERT_EQ( optical_depths(2,2), 85.0 )
+    ASSERT_EQ( optical_depths(3,2), 95.0 )
+
+    call radiator%get_single_scattering_albedos( single_scattering_albedos, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( single_scattering_albedos(1,1), 900.0 )
+    ASSERT_EQ( single_scattering_albedos(2,1), 800.0 )
+    ASSERT_EQ( single_scattering_albedos(3,1), 700.0 )
+    ASSERT_EQ( single_scattering_albedos(1,2), 750.0 )
+    ASSERT_EQ( single_scattering_albedos(2,2), 850.0 )
+    ASSERT_EQ( single_scattering_albedos(3,2), 950.0 )
+
+    call radiator%get_asymmetry_factors( asymmetry_factors, error )
+    ASSERT( error%is_success() )
+    ASSERT_EQ( asymmetry_factors(1,1,1), 9.0 )
+    ASSERT_EQ( asymmetry_factors(2,1,1), 8.0 )
+    ASSERT_EQ( asymmetry_factors(3,1,1), 7.0 )
+    ASSERT_EQ( asymmetry_factors(1,2,1), 5.0 )
+    ASSERT_EQ( asymmetry_factors(2,2,1), 4.0 )
+    ASSERT_EQ( asymmetry_factors(3,2,1), 3.0 )
+
     deallocate( grid )
     deallocate( grids )
     deallocate( profile )
     deallocate( profile_copy )
     deallocate( profiles )
+    deallocate( radiator_copy )
+    deallocate( radiator )
+    deallocate( radiators )
+    deallocate( height_grid )
+    deallocate( wavelength_grid )
     deallocate( tuvx )
 
   end subroutine test_tuvx_solve

fortran/tuvx/CMakeLists.txt

@@ -4,5 +4,7 @@ target_sources(musica-fortran
     grid_map.F90
     profile.F90
     profile_map.F90
+    radiator.F90
+    radiator_map.F90
     tuvx.F90
 )

fortran/tuvx/grid.F90

@@ -82,7 +82,7 @@ end subroutine get_grid_midpoints_c
     procedure :: set_edges
     ! Get grid edges
     procedure :: get_edges
-    ! Set the grid edges and midpoints
+    ! Set the grid midpoints
     procedure :: set_midpoints
     ! Get the grid midpoints
     procedure :: get_midpoints

fortran/tuvx/profile.F90

@@ -16,7 +16,7 @@ module musica_tuvx_profile
   interface
     function create_profile_c(profile_name, profile_units, grid, error) &
       bind(C, name="CreateProfile")
-      use iso_c_binding, only: c_ptr, c_char, c_size_t
+      use iso_c_binding, only: c_ptr, c_char
       use musica_util, only: error_t_c
       character(len=1, kind=c_char), intent(in) :: profile_name(*)
       character(len=1, kind=c_char), intent(in) :: profile_units(*)