mam  v1.0
A Modal Aerosol Model
optics_util.F90
Go to the documentation of this file.
1! Copyright (C) 2021 National Center for Atmospheric Research
2! SPDX-License-Identifier: Apache-2.0
3!
4!> \file
5!> Tests for the mam_optics_util module
6
7!> Tests for optics utility functions
8program test_optics_util
9
10 implicit none
11
12 call test_optics_util_functions( )
13
14contains
15
16!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17
18 subroutine test_optics_util_functions( )
19
20 use ai_wavelength_grid, only : wavelength_grid_t
21 use ai_optics, only : optics_t
22 use mam_optics_util, only : create_optics, &
23 add_shortwave_property, &
24 add_longwave_property
25 use musica_assert, only : assert
26 use musica_constants, only : dk => musica_dk
27 use musica_property, only : property_t
28 use mock_interpolation_strategy, only : foo_mapper
29
30 character(len=*), parameter :: my_name = "optics utility tests"
31 type(wavelength_grid_t) :: native_sw_grid, native_lw_grid, output_grid
32 type(property_t) :: property
33 class(optics_t), pointer :: optics
34 real(kind=dk) :: values(3)
35
36 native_sw_grid = wavelength_grid_t( (/ 0.0_dk, 10.0_dk, 200.0_dk /), &
37 (/ 10.0_dk, 110.0_dk, 400.0_dk /) )
38 native_lw_grid = wavelength_grid_t( (/ 10.0_dk, 400.0_dk /), &
39 (/ 20.0_dk, 600.0_dk /) )
40
41 ! no interpolation
42 output_grid = native_sw_grid
43 property = property_t( my_name, &
44 name = "layer extinction optical depth" )
45 optics => create_optics( property, native_sw_grid, native_lw_grid,&
46 output_grid )
47 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
48 call add_shortwave_property( (/ 150.0_dk, 0.0_dk, 10.0_dk /), &
49 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
50 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
51 optics )
52 values(:) = 0.0_dk
53 call optics%get_values( values )
54 call assert( 201129633, values(1) .eq. 150.0_dk )
55 call assert( 930972728, values(2) .eq. 0.0_dk )
56 call assert( 143291074, values(3) .eq. 10.0_dk )
57 deallocate( optics )
58
59 property = property_t( my_name, &
60 name = "layer single-scatter albedo" )
61 optics => create_optics( property, native_sw_grid, native_lw_grid,&
62 output_grid )
63 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
64 call add_shortwave_property( (/ 150.0_dk, 0.0_dk, 10.0_dk /), &
65 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
66 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
67 optics )
68 values(:) = 0.0_dk
69 call optics%get_values( values )
70 call assert( 692900946, values(1) .eq. 300.0_dk )
71 call assert( 805219291, values(2) .eq. 0.0_dk )
72 call assert( 635062387, values(3) .eq. 10.0_dk )
73 deallocate( optics )
74
75 property = property_t( my_name, &
76 name = "asymmetry factor" )
77 optics => create_optics( property, native_sw_grid, native_lw_grid,&
78 output_grid )
79 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
80 call add_shortwave_property( (/ 150.0_dk, 0.0_dk, 10.0_dk /), &
81 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
82 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
83 optics )
84 values(:) = 0.0_dk
85 call optics%get_values( values )
86 call assert( 914178863, values(1) .eq. 3000.0_dk )
87 call assert( 461546710, values(2) .eq. 0.0_dk )
88 call assert( 356398206, values(3) .eq. 250.0_dk )
89 deallocate( optics )
90
91 property = property_t( my_name, &
92 name = "forward scattered fraction" )
93 optics => create_optics( property, native_sw_grid, native_lw_grid,&
94 output_grid )
95 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
96 call add_shortwave_property( (/ 150.0_dk, 0.0_dk, 10.0_dk /), &
97 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
98 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
99 optics )
100 values(:) = 0.0_dk
101 call optics%get_values( values )
102 call assert( 630250375, values(1) .eq. 30000.0_dk )
103 call assert( 177618222, values(2) .eq. 0.0_dk )
104 call assert( 907461317, values(3) .eq. 6250.0_dk )
105 deallocate( optics )
106
107 output_grid = native_lw_grid
108 property = property_t( my_name, &
109 name = "layer absorption optical depth" )
110 optics => create_optics( property, native_sw_grid, native_lw_grid,&
111 output_grid )
112 call optics%set_values( (/ 0.0_dk, 0.0_dk /) )
113 call add_longwave_property( (/ 150.0_dk, 0.0_dk /), optics )
114 values(:) = 0.0_dk
115 call optics%get_values( values(1:2) )
116 call assert( 228739235, values(1) .eq. 150.0_dk )
117 call assert( 676107081, values(2) .eq. 0.0_dk )
118 call assert( 223474928, values(3) .eq. 0.0_dk )
119 deallocate( optics )
120
121 ! custom interpolation strategy
122 output_grid = wavelength_grid_t( (/ 4.0_dk, 14.0_dk, 210.0_dk /), &
123 (/ 13.0_dk, 105.0_dk, 403.0_dk /) )
124 property = property_t( my_name, &
125 name = "layer extinction optical depth" )
126 optics => create_optics( property, native_sw_grid, native_lw_grid,&
127 output_grid, &
128 interpolation_strategy = foo_mapper )
129 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
130 call add_shortwave_property( (/ 150.0_dk, 1.0_dk, 10.0_dk /), &
131 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
132 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
133 optics )
134 values(:) = 0.0_dk
135 call optics%get_values( values )
136 call assert( 577249425, values(1) .eq. 150.5_dk )
137 call assert( 689567770, values(2) .eq. 0.5_dk )
138 call assert( 519410866, values(3) .eq. 0.0_dk )
139 deallocate( optics )
140
141 property = property_t( my_name, &
142 name = "layer single-scatter albedo" )
143 optics => create_optics( property, native_sw_grid, native_lw_grid,&
144 output_grid, &
145 interpolation_strategy = foo_mapper )
146 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
147 call add_shortwave_property( (/ 150.0_dk, 1.0_dk, 10.0_dk /), &
148 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
149 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
150 optics )
151 values(:) = 0.0_dk
152 call optics%get_values( values )
153 call assert( 110016064, values(1) .eq. 302.5_dk )
154 call assert( 287342809, values(2) .eq. 2.5_dk )
155 call assert( 734710655, values(3) .eq. 0.0_dk )
156 deallocate( optics )
157
158 property = property_t( my_name, &
159 name = "asymmetry factor" )
160 optics => create_optics( property, native_sw_grid, native_lw_grid,&
161 output_grid, &
162 interpolation_strategy = foo_mapper )
163 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
164 call add_shortwave_property( (/ 150.0_dk, 1.0_dk, 10.0_dk /), &
165 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
166 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
167 optics )
168 values(:) = 0.0_dk
169 call optics%get_values( values )
170 call assert( 283984036, values(1) .eq. 3010.0_dk )
171 call assert( 113827132, values(2) .eq. 10.0_dk )
172 call assert( 561194978, values(3) .eq. 0.0_dk )
173 deallocate( optics )
174
175 property = property_t( my_name, &
176 name = "forward scattered fraction" )
177 optics => create_optics( property, native_sw_grid, native_lw_grid,&
178 output_grid, &
179 interpolation_strategy = foo_mapper )
180 call optics%set_values( (/ 0.0_dk, 0.0_dk, 0.0_dk /) )
181 call add_shortwave_property( (/ 150.0_dk, 1.0_dk, 10.0_dk /), &
182 (/ 2.0_dk, 5.0_dk, 1.0_dk /), &
183 (/ 10.0_dk, 4.0_dk, 25.0_dk /), &
184 optics )
185 values(:) = 0.0_dk
186 call optics%get_values( values )
187 call assert( 892885706, values(1) .eq. 30040.0_dk )
188 call assert( 440253553, values(2) .eq. 40.0_dk )
189 call assert( 335105049, values(3) .eq. 0.0_dk )
190 deallocate( optics )
191
192 property = property_t( my_name, &
193 name = "layer absorption optical depth" )
194 optics => create_optics( property, native_sw_grid, native_lw_grid,&
195 output_grid, &
196 interpolation_strategy = foo_mapper )
197 call optics%set_values( (/ 0.0_dk, 0.0_dk /) )
198 call add_longwave_property( (/ 150.0_dk, 1.0_dk /), optics )
199 values(:) = 0.0_dk
200 call optics%get_values( values )
201 call assert( 214163624, values(1) .eq. 150.5_dk )
202 call assert( 944006719, values(2) .eq. 0.5_dk )
203 call assert( 491374566, values(3) .eq. 0.0_dk )
204 deallocate( optics )
205
206 end subroutine test_optics_util_functions
207
208!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
209
210end program test_optics_util
mam_optics_util
Constants used to calculate MAM optical properties.
Definition: optics_util.F90:8
mam_optics_util::create_optics
class(optics_t) function, pointer, public create_optics(property, native_shortwave_grid, native_longwave_grid, output_grid, interpolation_strategy)
Returns an optics_t object for a given property.
Definition: optics_util.F90:35
mam_optics_util::add_shortwave_property
subroutine, public add_shortwave_property(extinction_optical_depth, single_scatter_albedo, asymmetry_factor, optics)
Adds to shortwave property values.
Definition: optics_util.F90:165
mam_optics_util::add_longwave_property
subroutine, public add_longwave_property(extinction_optical_depth, optics)
Adds to longwave property values.
Definition: optics_util.F90:213
test_optics_util
program test_optics_util
Tests for optics utility functions.
Definition: optics_util.F90:8
test_optics_util_functions
subroutine test_optics_util_functions()
Definition: optics_util.F90:19
Generated on Mon Aug 15 2022 15:01:05 for mam by doxygen 1.9.4