Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Develop-123-tuvx-radiation-grid #142

Merged
merged 1 commit into from
Oct 24, 2024
Merged

Develop-123-tuvx-radiation-grid #142

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions schemes/musica/musica_ccpp.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,14 +26,17 @@ end subroutine musica_ccpp_register
!> \section arg_table_musica_ccpp_init Argument Table
!! \htmlinclude musica_ccpp_init.html
subroutine musica_ccpp_init(vertical_layer_dimension, vertical_interface_dimension, &
errmsg, errcode)
photolysis_wavelength_grid_interfaces, errmsg, errcode)
use ccpp_kinds, only : kind_phys

integer, intent(in) :: vertical_layer_dimension ! (count)
integer, intent(in) :: vertical_interface_dimension ! (count)
real(kind_phys), intent(in) :: photolysis_wavelength_grid_interfaces(:) ! m
character(len=512), intent(out) :: errmsg
integer, intent(out) :: errcode

call tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
errmsg, errcode)
photolysis_wavelength_grid_interfaces, errmsg, errcode)
if (errcode /= 0) return
call micm_init(errmsg, errcode)
if (errcode /= 0) return
Expand Down
6 changes: 6 additions & 0 deletions schemes/musica/musica_ccpp.meta
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,12 @@
type = integer
dimensions = ()
intent = in
[ photolysis_wavelength_grid_interfaces ]
standard_name = photolysis_wavelength_grid_interfaces
units = m
Comment on lines +22 to +24
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

In the configuration (ts1_tsmlt.json), the unit is nm. Are we going to use m and to add conversion?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I saw the conversion. never mind!

type = real | kind = kind_phys
dimensions = (photolysis_wavelength_grid_interface_dimension)
intent = in
[ errmsg ]
standard_name = ccpp_error_message
units = none
Expand Down
54 changes: 51 additions & 3 deletions schemes/musica/tuvx/musica_ccpp_tuvx.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,19 +14,24 @@ module musica_ccpp_tuvx

type(tuvx_t), pointer :: tuvx => null( )
type(grid_t), pointer :: height_grid => null( )
type(grid_t), pointer :: wavelength_grid => null( )

contains

!> Intitialize TUV-x
subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
errmsg, errcode)
wavelength_grid_interfaces, errmsg, errcode)
use musica_tuvx, only: grid_map_t, profile_map_t, radiator_map_t
use musica_util, only: error_t
use musica_ccpp_tuvx_height_grid, only: create_height_grid, &
height_grid_label, height_grid_unit
use musica_ccpp_tuvx_wavelength_grid, only: create_wavelength_grid, &
wavelength_grid_label, &
wavelength_grid_unit

integer, intent(in) :: vertical_layer_dimension ! (count)
integer, intent(in) :: vertical_interface_dimension ! (count)
integer, intent(in) :: vertical_layer_dimension ! (count)
integer, intent(in) :: vertical_interface_dimension ! (count)
real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m
character(len=512), intent(out) :: errmsg
integer, intent(out) :: errcode

Expand Down Expand Up @@ -54,11 +59,32 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
return
end if

wavelength_grid => create_wavelength_grid( wavelength_grid_interfaces, &
errmsg, errcode )
if (errcode /= 0) then
deallocate( grids )
deallocate( height_grid )
height_grid => null()
return
endif

call grids%add( wavelength_grid, error )
if (has_error_occurred( error, errmsg, errcode )) then
deallocate( grids )
deallocate( height_grid )
height_grid => null()
deallocate( wavelength_grid )
wavelength_grid => null()
return
end if

profiles => profile_map_t( error )
if (has_error_occurred( error, errmsg, errcode )) then
deallocate( grids )
deallocate( height_grid )
height_grid => null()
deallocate( wavelength_grid )
wavelength_grid => null()
return
end if

Expand All @@ -68,6 +94,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
deallocate( profiles )
deallocate( height_grid )
height_grid => null()
deallocate( wavelength_grid )
wavelength_grid => null()
return
end if

Expand All @@ -79,6 +107,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
deallocate( radiators )
deallocate( height_grid )
height_grid => null()
deallocate( wavelength_grid )
wavelength_grid => null()
return
end if

Expand All @@ -87,6 +117,8 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
deallocate( radiators )
deallocate( height_grid )
height_grid => null()
deallocate( wavelength_grid )
wavelength_grid => null()

grids => tuvx%get_grids( error )
if (has_error_occurred( error, errmsg, errcode )) then
Expand All @@ -103,6 +135,17 @@ subroutine tuvx_init(vertical_layer_dimension, vertical_interface_dimension, &
return
end if

wavelength_grid => grids%get( wavelength_grid_label, wavelength_grid_unit, &
error )
if (has_error_occurred( error, errmsg, errcode )) then
deallocate( tuvx )
tuvx => null()
deallocate( grids )
deallocate( height_grid )
height_grid => null()
return
end if

deallocate( grids )

end subroutine tuvx_init
Expand Down Expand Up @@ -166,6 +209,11 @@ subroutine tuvx_final(errmsg, errcode)
height_grid => null()
end if

if (associated( wavelength_grid )) then
deallocate( wavelength_grid )
wavelength_grid => null()
end if

if (associated( tuvx )) then
deallocate( tuvx )
tuvx => null()
Expand Down
31 changes: 27 additions & 4 deletions schemes/musica/tuvx/musica_ccpp_tuvx_wavelength_grid.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,17 @@ module musica_ccpp_tuvx_wavelength_grid
private
public :: create_wavelength_grid

! TUV-x Wavelegnth grid notes
!
!-----------------------------------------------------------------------
! The wavelength grid used with TUV-x is based on the grid used in the
! CAM-Chem photolysis rate constant lookup tables. Slight modifications
! were made to the grid in the Shumann-Runge and Lyman-alpha regions to
! work with the expectations of the TUV-x code.
!
! The wavelength grid is defined by the host model. Any wavelength-
! resolved quantities passed to TUV-x must be on this grid.

!> Label for height grid in TUV-x
character(len=*), parameter, public :: wavelength_grid_label = "wavelength"
!> Units for height grid in TUV-x
Expand All @@ -13,23 +24,35 @@ module musica_ccpp_tuvx_wavelength_grid
contains

!> Creates a TUV-x wavelength grid
function create_wavelength_grid( num_wavelength_bin, errmsg, errcode ) &
function create_wavelength_grid( wavelength_grid_interfaces, errmsg, errcode ) &
result( wavelength_grid )

use ccpp_kinds, only: kind_phys
use musica_ccpp_util, only: has_error_occurred
use musica_config, only: config_t
use musica_tuvx_grid, only: grid_t
use musica_util, only: error_t

integer, intent(in) :: num_wavelength_bin
real(kind_phys), intent(in) :: wavelength_grid_interfaces(:) ! m
character(len=*), intent(out) :: errmsg
integer, intent(out) :: errcode
type(grid_t), pointer :: wavelength_grid

! local variable
! local variables
real(kind_phys) :: interfaces( size( wavelength_grid_interfaces ) ) ! [nm]
reaL(kind_phys) :: midpoints( size( wavelength_grid_interfaces ) - 1 ) ! [nm]
type(error_t) :: error

interfaces(:) = wavelength_grid_interfaces(:) * 1.0e9
midpoints(:) = &
0.5 * ( interfaces( 1: size( interfaces ) - 1 ) &
+ interfaces( 2: size( interfaces ) ) )
wavelength_grid => grid_t( wavelength_grid_label, wavelength_grid_unit, &
num_wavelength_bin, error )
size( midpoints ), error )
if ( has_error_occurred( error, errmsg, errcode ) ) return
call wavelength_grid%set_edges( interfaces, error )
if ( has_error_occurred( error, errmsg, errcode ) ) return
call wavelength_grid%set_midpoints( midpoints, error )
if ( has_error_occurred( error, errmsg, errcode ) ) return

end function create_wavelength_grid
Expand Down
115 changes: 114 additions & 1 deletion test/musica/test_musica_api.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,12 @@ subroutine test_musica_ccpp_api()
integer, parameter :: NUM_SPECIES = 4
integer, parameter :: NUM_COLUMNS = 2
integer, parameter :: NUM_LAYERS = 2
integer, parameter :: NUM_WAVELENGTH_BINS = 102
integer :: solver_type
integer :: errcode
character(len=512) :: errmsg
real(kind_phys) :: time_step ! s
real(kind_phys), dimension(NUM_WAVELENGTH_BINS+1) :: photolysis_wavelength_grid_interfaces ! m
real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS) :: geopotential_height_wrt_surface_at_midpoint ! m
real(kind_phys), dimension(NUM_COLUMNS,NUM_LAYERS+1) :: geopotential_height_wrt_surface_at_interface ! m
real(kind_phys), dimension(NUM_COLUMNS) :: surface_geopotential ! m2 s-2
Expand All @@ -47,6 +49,116 @@ subroutine test_musica_ccpp_api()
solver_type = Rosenbrock
num_grid_cells = NUM_COLUMNS * NUM_LAYERS
time_step = 60._kind_phys
! These are the values that will be used in CAM-SIMA and correspond to the wavelength
! bins used in the CAM-Chem photolysis rate constant lookup table.
!
! We're using the actual values here because several of the TS1/TSMLT photolysis
! rate constant configurations are sensitive to the wavelength grid.
photolysis_wavelength_grid_interfaces = (/ &
120.0e-9_kind_phys, &
121.4e-9_kind_phys, &
121.9e-9_kind_phys, &
123.5e-9_kind_phys, &
124.3e-9_kind_phys, &
125.5e-9_kind_phys, &
126.3e-9_kind_phys, &
127.1e-9_kind_phys, &
130.1e-9_kind_phys, &
131.1e-9_kind_phys, &
135.0e-9_kind_phys, &
140.0e-9_kind_phys, &
145.0e-9_kind_phys, &
150.0e-9_kind_phys, &
155.0e-9_kind_phys, &
160.0e-9_kind_phys, &
165.0e-9_kind_phys, &
168.0e-9_kind_phys, &
171.0e-9_kind_phys, &
173.0e-9_kind_phys, &
174.4e-9_kind_phys, &
175.4e-9_kind_phys, &
177.0e-9_kind_phys, &
178.6e-9_kind_phys, &
180.2e-9_kind_phys, &
181.8e-9_kind_phys, &
183.5e-9_kind_phys, &
185.2e-9_kind_phys, &
186.9e-9_kind_phys, &
188.7e-9_kind_phys, &
190.5e-9_kind_phys, &
192.3e-9_kind_phys, &
194.2e-9_kind_phys, &
196.1e-9_kind_phys, &
198.0e-9_kind_phys, &
200.0e-9_kind_phys, &
202.0e-9_kind_phys, &
204.1e-9_kind_phys, &
206.2e-9_kind_phys, &
208.0e-9_kind_phys, &
211.0e-9_kind_phys, &
214.0e-9_kind_phys, &
217.0e-9_kind_phys, &
220.0e-9_kind_phys, &
223.0e-9_kind_phys, &
226.0e-9_kind_phys, &
229.0e-9_kind_phys, &
232.0e-9_kind_phys, &
235.0e-9_kind_phys, &
238.0e-9_kind_phys, &
241.0e-9_kind_phys, &
244.0e-9_kind_phys, &
247.0e-9_kind_phys, &
250.0e-9_kind_phys, &
253.0e-9_kind_phys, &
256.0e-9_kind_phys, &
259.0e-9_kind_phys, &
263.0e-9_kind_phys, &
267.0e-9_kind_phys, &
271.0e-9_kind_phys, &
275.0e-9_kind_phys, &
279.0e-9_kind_phys, &
283.0e-9_kind_phys, &
287.0e-9_kind_phys, &
291.0e-9_kind_phys, &
295.0e-9_kind_phys, &
298.5e-9_kind_phys, &
302.5e-9_kind_phys, &
305.5e-9_kind_phys, &
308.5e-9_kind_phys, &
311.5e-9_kind_phys, &
314.5e-9_kind_phys, &
317.5e-9_kind_phys, &
322.5e-9_kind_phys, &
327.5e-9_kind_phys, &
332.5e-9_kind_phys, &
337.5e-9_kind_phys, &
342.5e-9_kind_phys, &
347.5e-9_kind_phys, &
350.0e-9_kind_phys, &
355.0e-9_kind_phys, &
360.0e-9_kind_phys, &
365.0e-9_kind_phys, &
370.0e-9_kind_phys, &
375.0e-9_kind_phys, &
380.0e-9_kind_phys, &
385.0e-9_kind_phys, &
390.0e-9_kind_phys, &
395.0e-9_kind_phys, &
400.0e-9_kind_phys, &
405.0e-9_kind_phys, &
410.0e-9_kind_phys, &
415.0e-9_kind_phys, &
420.0e-9_kind_phys, &
430.0e-9_kind_phys, &
440.0e-9_kind_phys, &
450.0e-9_kind_phys, &
500.0e-9_kind_phys, &
550.0e-9_kind_phys, &
600.0e-9_kind_phys, &
650.0e-9_kind_phys, &
700.0e-9_kind_phys, &
750.0e-9_kind_phys &
/)
geopotential_height_wrt_surface_at_midpoint(1,:) = (/ 2000.0_kind_phys, 500.0_kind_phys /)
geopotential_height_wrt_surface_at_midpoint(2,:) = (/ 2000.0_kind_phys, -500.0_kind_phys /)
geopotential_height_wrt_surface_at_interface(1,:) = (/ 3000.0_kind_phys, 1000.0_kind_phys, 0.0_kind_phys /)
Expand Down Expand Up @@ -96,7 +208,8 @@ subroutine test_musica_ccpp_api()
call constituent_props_ptr(i)%set(const_prop, errcode, errmsg)
end do

call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, errmsg, errcode)
call musica_ccpp_init(NUM_LAYERS, NUM_LAYERS+1, photolysis_wavelength_grid_interfaces, &
errmsg, errcode)
if (errcode /= 0) then
write(*,*) trim(errmsg)
stop 3
Expand Down
28 changes: 28 additions & 0 deletions test/musica/tuvx/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,34 @@ add_test(

add_memory_check_test(test_tuvx_height_grid $<TARGET_FILE:test_tuvx_height_grid> "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY})

# Wavelength grid
add_executable(test_tuvx_wavelength_grid test_tuvx_wavelength_grid.F90)

target_sources(test_tuvx_wavelength_grid
PUBLIC
${MUSICA_SRC_PATH}/tuvx/musica_ccpp_tuvx_wavelength_grid.F90
${MUSICA_SRC_PATH}/musica_ccpp_util.F90
${CCPP_TEST_SRC_PATH}/ccpp_kinds.F90
)

target_link_libraries(test_tuvx_wavelength_grid
PRIVATE
musica::musica-fortran
)

set_target_properties(test_tuvx_wavelength_grid
PROPERTIES
LINKER_LANGUAGE Fortran
)

add_test(
NAME test_tuvx_wavelength_grid
COMMAND $<TARGET_FILE:test_tuvx_wavelength_grid>
WORKING_DIRECTORY ${CMAKE_RUNTIME_OUTPUT_DIRECTORY}
)

add_memory_check_test(test_tuvx_wavelength_grid $<TARGET_FILE:test_tuvx_wavelength_grid> "" ${CMAKE_RUNTIME_OUTPUT_DIRECTORY})

# Temperature
add_executable(test_tuvx_temperature test_tuvx_temperature.F90)

Expand Down
6 changes: 0 additions & 6 deletions test/musica/tuvx/configs/ts1_tsmlt.json
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,12 +4,6 @@
"cross section parameters file": "data/cross_sections/O2_parameters.txt"
},
"grids": [
{
"name": "wavelength",
"type": "from csv file",
"units": "nm",
"file path": "data/grids/wavelength/cam.csv"
},
{
"name": "time",
"type": "from config file",
Expand Down
Loading