-
Notifications
You must be signed in to change notification settings - Fork 20
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
resolve the merge conflict with main
- Loading branch information
Showing
9 changed files
with
263 additions
and
7 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
103 changes: 103 additions & 0 deletions
103
schemes/musica/tuvx/musica_ccpp_tuvx_aerosol_optics.F90
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,103 @@ | ||
| ! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research | ||
| ! SPDX-License-Identifier: Apache-2.0 | ||
| module musica_ccpp_tuvx_aerosol_optics | ||
| implicit none | ||
|
|
||
| private | ||
| public :: create_aerosol_optics_radiator, set_aerosol_optics_values | ||
|
|
||
| !> Label for aerosol optical properties in TUV-x | ||
| character(len=*), parameter, public :: aerosol_optics_label = "aerosols" | ||
| !> Label | ||
| character(len=*), parameter, public :: \ | ||
| aerosol_optical_depth_label = "optical depths" | ||
| character(len=*), parameter, public :: \ | ||
| aerosol_single_scattering_albedo_label = "single scattering albedos" | ||
| character(len=*), parameter, public :: \ | ||
| aerosol_asymmetry_factor_label = "asymmetry factor" | ||
| !> Unit | ||
| character(len=*), parameter, public :: aerosol_optical_depth_unit = "none" | ||
| character(len=*), parameter, public :: aerosol_single_scattering_albedo_unit = "none" | ||
| character(len=*), parameter, public :: aerosol_asymmetry_factor_unit = "none" | ||
| !> Default value of number of vertical levels | ||
| integer, parameter :: DEFAULT_NUM_VERTICAL_LEVELS = 0 | ||
| !> Number of vertical levels | ||
| integer, protected :: num_vertical_levels = DEFAULT_NUM_VERTICAL_LEVELS | ||
| !> Default value of number of wavelength bins | ||
| integer, parameter :: DEFAULT_NUM_WAVELENGTH_BINS = 0 | ||
| !> Number of wavelength bins | ||
| integer, protected :: num_wavelength_bins = DEFAULT_NUM_WAVELENGTH_BINS | ||
| !> Default value of number of streams | ||
| integer, parameter :: DEFAULT_NUM_STREAMS = 1 | ||
| !> Number of streams | ||
| integer, protected :: num_streams = DEFAULT_NUM_STREAMS | ||
|
|
||
| contains | ||
|
|
||
| !> Creates a TUV-x aerosol optics radiator | ||
| function create_aerosol_optics_radiator( height_grid, wavelength_grid, & | ||
| errmsg, errcode ) result( radiator ) | ||
| use musica_ccpp_util, only: has_error_occurred | ||
| use musica_tuvx_grid, only: grid_t | ||
| use musica_tuvx_radiator, only: radiator_t | ||
| use musica_util, only: error_t | ||
|
|
||
| type(grid_t), intent(inout) :: height_grid | ||
| type(grid_t), intent(inout) :: wavelength_grid | ||
| character(len=*), intent(out) :: errmsg | ||
| integer, intent(out) :: errcode | ||
| type(radiator_t), pointer :: radiator | ||
|
|
||
| ! local variables | ||
| type(error_t) :: error | ||
|
|
||
| num_vertical_levels = height_grid%number_of_sections( error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| num_wavelength_bins = wavelength_grid%number_of_sections( error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| radiator => radiator_t( aerosol_optics_label, height_grid, wavelength_grid, & | ||
| error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| end function create_aerosol_optics_radiator | ||
|
|
||
| !> Sets TUV-x aerosol optics values | ||
| ! Temporarily setting optical properties to zero until aerosol optical | ||
| ! property calculations are ported to CAM-SIMA. | ||
| subroutine set_aerosol_optics_values( radiator, errmsg, errcode ) | ||
| use ccpp_kinds, only: kind_phys | ||
| use musica_ccpp_util, only: has_error_occurred | ||
| use musica_tuvx_radiator, only: radiator_t | ||
| use musica_util, only: error_t | ||
|
|
||
| type(radiator_t), intent(inout) :: radiator | ||
| character(len=*), intent(out) :: errmsg | ||
| integer, intent(out) :: errcode | ||
|
|
||
| ! local variables | ||
| type(error_t) :: error | ||
| real(kind_phys) :: \ | ||
| aerosol_optical_depth(num_vertical_levels, num_wavelength_bins) | ||
| real(kind_phys) :: \ | ||
| aerosol_single_scattering_albedo(num_vertical_levels, num_wavelength_bins) | ||
| real(kind_phys) :: \ | ||
| aerosol_asymmetry_factor(num_vertical_levels, num_wavelength_bins, num_streams) | ||
|
|
||
| aerosol_optical_depth(:,:) = 0.0_kind_phys | ||
| aerosol_single_scattering_albedo(:,:) = 0.0_kind_phys | ||
| aerosol_asymmetry_factor(:,:,:) = 0.0_kind_phys | ||
|
|
||
| call radiator%set_optical_depths( aerosol_optical_depth, error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| call radiator%set_single_scattering_albedos( aerosol_single_scattering_albedo, error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| call radiator%set_asymmetry_factors( aerosol_asymmetry_factor, error ) | ||
| if ( has_error_occurred( error, errmsg, errcode ) ) return | ||
|
|
||
| end subroutine set_aerosol_optics_values | ||
|
|
||
| end module musica_ccpp_tuvx_aerosol_optics |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,85 @@ | ||
| ! Copyright (C) 2024 National Science Foundation-National Center for Atmospheric Research | ||
| ! SPDX-License-Identifier: Apache-2.0 | ||
| program test_tuvx_aerosol_optics | ||
|
|
||
| use musica_ccpp_tuvx_aerosol_optics | ||
|
|
||
| #define ASSERT(x) if (.not.(x)) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: x"; stop 1; endif | ||
| #define ASSERT_NEAR( a, b, abs_error ) if( (abs(a - b) >= abs_error) .and. (abs(a - b) /= 0.0) ) then; write(*,*) "Assertion failed[", __FILE__, ":", __LINE__, "]: a, b"; stop 1; endif | ||
|
|
||
| call test_create_aerosol_optics_radiator() | ||
|
|
||
| contains | ||
|
|
||
| subroutine test_create_aerosol_optics_radiator() | ||
|
|
||
| use musica_util, only: error_t | ||
| use musica_ccpp_tuvx_height_grid, only: create_height_grid | ||
| use musica_ccpp_tuvx_wavelength_grid, only: create_wavelength_grid | ||
| use musica_tuvx_grid, only: grid_t | ||
| use musica_tuvx_radiator, only: radiator_t | ||
| use ccpp_kinds, only: kind_phys | ||
|
|
||
| integer, parameter :: NUM_HOST_HEIGHT_MIDPOINTS = 2 | ||
| integer, parameter :: NUM_HOST_HEIGHT_INTERFACES = 3 | ||
| integer, parameter :: NUM_WAVELENGTH_MIDPOINTS = 3 | ||
| integer, parameter :: NUM_WAVELENGTH_INTERFACES = 4 | ||
| real(kind_phys) :: host_wavelength_interfaces(NUM_WAVELENGTH_INTERFACES) = [180.0e-9_kind_phys, 200.0e-9_kind_phys, 240.0e-9_kind_phys, 300.0e-9_kind_phys] | ||
| real(kind_phys) :: aerosol_optical_depth(NUM_HOST_HEIGHT_MIDPOINTS+1, NUM_WAVELENGTH_MIDPOINTS) | ||
| real(kind_phys) :: single_scattering_albedo(NUM_HOST_HEIGHT_MIDPOINTS+1, NUM_WAVELENGTH_MIDPOINTS) | ||
| real(kind_phys) :: asymmetry_parameter(NUM_HOST_HEIGHT_MIDPOINTS+1, NUM_WAVELENGTH_MIDPOINTS,1) | ||
| type(grid_t), pointer :: height_grid => null() | ||
| type(grid_t), pointer :: wavelength_grid => null() | ||
| type(radiator_t), pointer :: aerosols => null() | ||
| type(error_t) :: error | ||
| character(len=512) :: errmsg | ||
| integer :: errcode | ||
| integer :: i | ||
|
|
||
| height_grid => create_height_grid(NUM_HOST_HEIGHT_MIDPOINTS, NUM_HOST_HEIGHT_INTERFACES, & | ||
| errmsg, errcode) | ||
| ASSERT(errcode == 0) | ||
| ASSERT(associated(height_grid)) | ||
|
|
||
| wavelength_grid => create_wavelength_grid(host_wavelength_interfaces, errmsg, errcode) | ||
| ASSERT(errcode == 0) | ||
| ASSERT(associated(wavelength_grid)) | ||
|
|
||
| aerosols => create_aerosol_optics_radiator(height_grid, wavelength_grid, errmsg, errcode) | ||
| ASSERT(errcode == 0) | ||
| ASSERT(associated(aerosols)) | ||
|
|
||
| call set_aerosol_optics_values(aerosols, errmsg, errcode) | ||
| ASSERT(errcode == 0) | ||
|
|
||
| call aerosols%get_optical_depths(aerosol_optical_depth, error) | ||
| ASSERT(error%is_success()) | ||
| do i = 1, size(aerosol_optical_depth, dim=1) | ||
| do j = 1, size(aerosol_optical_depth, dim=2) | ||
| ASSERT_NEAR(aerosol_optical_depth(i,j), 0.0_kind_phys, ABS_ERROR) | ||
| end do | ||
| end do | ||
|
|
||
| call aerosols%get_single_scattering_albedos(single_scattering_albedo, error) | ||
| ASSERT(error%is_success()) | ||
| do i = 1, size(single_scattering_albedo, dim=1) | ||
| do j = 1, size(single_scattering_albedo, dim=2) | ||
| ASSERT_NEAR(single_scattering_albedo(i,j), 0.0_kind_phys, ABS_ERROR) | ||
| end do | ||
| end do | ||
|
|
||
| call aerosols%get_asymmetry_factors(asymmetry_parameter, error) | ||
| ASSERT(error%is_success()) | ||
| do i = 1, size(asymmetry_parameter, dim=1) | ||
| do j = 1, size(asymmetry_parameter, dim=2) | ||
| ASSERT_NEAR(asymmetry_parameter(i,j,1), 0.0_kind_phys, ABS_ERROR) | ||
| end do | ||
| end do | ||
|
|
||
| deallocate( height_grid ) | ||
| deallocate( wavelength_grid ) | ||
| deallocate( aerosols ) | ||
|
|
||
| end subroutine test_create_aerosol_optics_radiator | ||
|
|
||
| end program test_tuvx_aerosol_optics |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters