mam  v1.0
A Modal Aerosol Model
optics_lookup.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_lookup module
6
7!> Test module for the mam_optics_lookup module
9
10 implicit none
11
13
14contains
15
16!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17
19
20 use ai_wavelength_grid, only : wavelength_grid_t, &
21 kwavenumber, kcentimeter
23 use musica_assert, only : assert, almost_equal
24 use musica_config, only : config_t
25 use musica_constants, only : dk => musica_dk
26
27 integer, parameter :: kNumberOfBands = 3
28 integer, parameter :: kNumberOfCoefficients = 2
29 type(optics_lookup_t) :: a, b, c
30 type(config_t) :: config
31 type(wavelength_grid_t) :: compare_grid
32 complex(kind=dk) :: ref_ind( kNumberOfBands )
33 real(kind=dk) :: absorp( knumberofcoefficients, knumberofbands )
34 real(kind=dk) :: ext( knumberofcoefficients, knumberofbands )
35 real(kind=dk) :: asym( knumberofcoefficients, knumberofbands )
36
37 ! set up grid to compare with loaded values
38 compare_grid = wavelength_grid_t( (/ 0.1_dk, 2.3_dk, 4.3_dk /), &
39 (/ 0.9_dk, 4.3_dk, 10.2_dk /), &
40 bounds_in = kwavenumber, &
41 base_unit = kcentimeter )
42
43 !! lookup table w/o any optical properties
44
45 call config%from_file( "optics_lookup_a_config.json" )
46 a = optics_lookup_t( config )
47
48 ! check wavelength grid
49 call assert( 903443825, a%grid( ) .eq. compare_grid )
50
51 ! check number of wavelength bands
52 call assert( 173056488, a%number_of_wavelength_bands( ) &
53 .eq. knumberofbands )
54
55 ! check number of Chebyshev coefficients
56 call assert( 218913194, a%number_of_chebyshev_coefficients( ) &
57 .eq. 0 )
58
59 ! check maximum radius
60 call assert( 101473010, &
61 almost_equal( a%maximum_radius__m( ), 1.0e-06_dk ) )
62
63 ! check minimum radius
64 call assert( 435069272, &
65 almost_equal( a%minimum_radius__m( ), 1.0e-08_dk ) )
66
67 ! normalized radius
68 call assert( 886248186, a%normalize_radius( 1.0e-09_dk ) &
69 .eq. -1.0_dk )
70 call assert( 535858059, &
71 almost_equal( a%normalize_radius( 1.0e-07_dk ), &
72 0.0_dk ) )
73 call assert( 983225905, a%normalize_radius( 1.0e-05_dk ) &
74 .eq. 1.0_dk )
75
76 ! get optics (returns nothing)
77 ref_ind(:) = cmplx( 0.0_dk, 0.0_dk )
78 call a%get_optics( ref_ind )
79
80
81 !! lookup table w/ absorption
82
83 call config%from_file( "optics_lookup_b_config.json" )
84 b = optics_lookup_t( config )
85
86 ! check wavelength grid
87 call assert( 842246493, b%grid( ) .eq. compare_grid )
88
89 ! check number of wavelength bands
90 call assert( 499935204, b%number_of_wavelength_bands( ) &
91 .eq. knumberofbands )
92
93 ! check number of Chebyshev coefficients
94 call assert( 612253549, b%number_of_chebyshev_coefficients( ) &
95 .eq. knumberofcoefficients )
96
97 ! check maximum radius
98 call assert( 747335190, &
99 almost_equal( b%maximum_radius__m( ), 1.0e-06_dk ) )
100
101 ! check minimum radius
102 call assert( 177120385, &
103 almost_equal( b%minimum_radius__m( ), 1.0e-08_dk ) )
104
105 ! normalized radius
106 call assert( 854389228, b%normalize_radius( 1.0e-09_dk ) &
107 .eq. -1.0_dk )
108 call assert( 684232324, &
109 almost_equal( b%normalize_radius( 1.0e-07_dk ), &
110 0.0_dk ) )
111 call assert( 796550669, b%normalize_radius( 1.0e-05_dk ) &
112 .eq. 1.0_dk )
113
114 ! get optics (absorption)
115 ref_ind(2) = cmplx( 5.0_dk, 60.0_dk )
116 call b%get_optics( ref_ind, absorption = absorp )
117
118 call assert( 543590556, absorp(1,1) .eq. 0.0_dk )
119 call assert( 422649131, absorp(2,1) .eq. 0.0_dk )
120 call assert( 252492227, absorp(1,2) .eq. 4.0_dk )
121 call assert( 764868473, absorp(2,2) .eq. 7.0_dk )
122 call assert( 312236320, absorp(1,3) .eq. 0.0_dk )
123 call assert( 759604166, absorp(2,3) .eq. 0.0_dk )
124
125 ref_ind(2) = cmplx( 5.0_dk, 50.0_dk )
126 call b%get_optics( ref_ind, absorption = absorp )
127
128 call assert( 709234178, absorp(1,1) .eq. 0.0_dk )
129 call assert( 646131312, absorp(2,1) .eq. 0.0_dk )
130 call assert( 475974408, absorp(1,2) .eq. 3.0_dk )
131 call assert( 588292753, absorp(2,2) .eq. 6.0_dk )
132 call assert( 135660600, absorp(1,3) .eq. 0.0_dk )
133 call assert( 312987345, absorp(2,3) .eq. 0.0_dk )
134
135 ref_ind(2) = cmplx( 6.0_dk, 60.0_dk )
136 call b%get_optics( ref_ind, absorption = absorp )
137
138 call assert( 299099958, absorp(1,1) .eq. 0.0_dk )
139 call assert( 411418303, absorp(2,1) .eq. 0.0_dk )
140 call assert( 306269799, absorp(1,2) .eq. 9.0_dk )
141 call assert( 753637645, absorp(2,2) .eq. 14.0_dk )
142 call assert( 301005492, absorp(1,3) .eq. 0.0_dk )
143 call assert( 130848588, absorp(2,3) .eq. 0.0_dk )
144
145 ! interpolation tests
146 ref_ind(2) = cmplx( 5.5_dk, 60.0_dk )
147 call b%get_optics( ref_ind, absorption = absorp )
148
149 call assert( 313726763, absorp(1,1) .eq. 0.0_dk )
150 call assert( 761094609, absorp(2,1) .eq. 0.0_dk )
151 call assert( 873412954, absorp(1,2) .eq. 6.5_dk )
152 call assert( 420780801, absorp(2,2) .eq. 10.5_dk )
153 call assert( 868148647, absorp(1,3) .eq. 0.0_dk )
154 call assert( 697991743, absorp(2,3) .eq. 0.0_dk )
155
156 ref_ind(2) = cmplx( 5.0_dk, 55.0_dk )
157 call b%get_optics( ref_ind, absorption = absorp )
158
159 call assert( 527834839, absorp(1,1) .eq. 0.0_dk )
160 call assert( 422686335, absorp(2,1) .eq. 0.0_dk )
161 call assert( 252529431, absorp(1,2) .eq. 3.5_dk )
162 call assert( 982372526, absorp(2,2) .eq. 6.5_dk )
163 call assert( 812215622, absorp(1,3) .eq. 0.0_dk )
164 call assert( 359583469, absorp(2,3) .eq. 0.0_dk )
165
166 !! lookup table w/ absorption, extinction, and asymmetry factor
167
168 call config%from_file( "optics_lookup_c_config.json" )
169 c = optics_lookup_t( config )
170
171 ! check wavelength grid
172 call assert( 561676778, c%grid( ) .eq. compare_grid )
173
174 ! check number of wavelength bands
175 call assert( 831625932, c%number_of_wavelength_bands( ) &
176 .eq. knumberofbands )
177
178 ! check number of Chebyshev coefficients
179 call assert( 273845275, c%number_of_chebyshev_coefficients( ) &
180 .eq. knumberofcoefficients )
181
182 ! check maximum radius
183 call assert( 967771318, &
184 almost_equal( c%maximum_radius__m( ), 1.0e-06_dk ) )
185
186 ! check minimum radius
187 call assert( 127515412, &
188 almost_equal( c%minimum_radius__m( ), 1.0e-08_dk ) )
189
190 ! normalized radius
191 call assert( 122251105, c%normalize_radius( 1.0e-09_dk ) &
192 .eq. -1.0_dk )
193 call assert( 517044699, &
194 almost_equal( c%normalize_radius( 1.0e-07_dk ), &
195 0.0_dk ) )
196 call assert( 511780392, c%normalize_radius( 1.0e-05_dk ) &
197 .eq. 1.0_dk )
198
199 ! get optics (absorption)
200 ref_ind(2) = cmplx( 5.0_dk, 60.0_dk )
201 call c%get_optics( ref_ind, absorption = absorp, extinction = ext, &
202 asymmetry_factor = asym )
203
204 call assert( 622645498, absorp(1,1) .eq. 0.0_dk )
205 call assert( 170013345, absorp(2,1) .eq. 0.0_dk )
206 call assert( 899856440, absorp(1,2) .eq. 4.0_dk )
207 call assert( 447224287, absorp(2,2) .eq. 7.0_dk )
208 call assert( 342075783, absorp(1,3) .eq. 0.0_dk )
209 call assert( 171918879, absorp(2,3) .eq. 0.0_dk )
210
211 call assert( 724887524, ext(1,1) .eq. 0.0_dk )
212 call assert( 272255371, ext(2,1) .eq. 0.0_dk )
213 call assert( 719623217, ext(1,2) .eq. 7.0_dk )
214 call assert( 266991064, ext(2,2) .eq. 2.0_dk )
215 call assert( 161842560, ext(1,3) .eq. 0.0_dk )
216 call assert( 609210406, ext(2,3) .eq. 0.0_dk )
217
218 call assert( 721528751, asym(1,1) .eq. 0.0_dk )
219 call assert( 551371847, asym(2,1) .eq. 0.0_dk )
220 call assert( 998739693, asym(1,2) .eq. 9.0_dk )
221 call assert( 546107540, asym(2,2) .eq. 11.0_dk )
222 call assert( 440959036, asym(1,3) .eq. 0.0_dk )
223 call assert( 605851633, asym(2,3) .eq. 0.0_dk )
224
225 end subroutine test_optics_lookup_t
226
227!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
228
229end program test_optics_lookup
The optics_lookup_t type and related functions.
real(kind=musica_dk), dimension(:,:), intent(out), optional asymmetry_factor
real(kind=musica_dk), dimension(:,:), intent(out), optional absorption
real(kind=musica_dk), dimension(:,:), intent(out), optional extinction
program test_optics_lookup
Test module for the mam_optics_lookup module.
subroutine test_optics_lookup_t()