mam  v1.0
A Modal Aerosol Model
core.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_core module
6
7!> Test program for the core_t type and related functions
8program test_core
9
10 implicit none
11
12 call test_core_t( )
13
14contains
15
16!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
17
18 subroutine test_core_t( )
19
20 use ai_aerosol_state, only : aerosol_state_t
21 use ai_environmental_state, only : environmental_state_t
22 use ai_optics, only : optics_t, optics_ptr
23 use ai_wavelength_grid, only : wavelength_grid_t
24 use mam_core, only : core_t, state_t
25 use mam_optics_lookup, only : optics_lookup_t
26 use musica_assert, only : assert, almost_equal
27 use musica_config, only : config_t
28 use musica_constants, only : dk => musica_dk
29 use musica_property, only : property_t
30
31 character(len=*), parameter :: my_name = "core_t tests"
32 type(core_t), pointer :: core
33 class(aerosol_state_t), pointer :: state_a, state_b
34 type(config_t) :: core_config, optics_config
35 class(optics_t), pointer :: optics
36 type(optics_ptr), allocatable :: optics_set(:)
37 type(environmental_state_t) :: env_state
38 type(wavelength_grid_t) :: grid
39 type(property_t) :: prop
40 type(optics_lookup_t) :: mock_optics_lookup
41 real(kind=dk), allocatable :: raw_state_a(:), raw_state_b(:)
42 real(kind=dk), allocatable :: optics_values(:)
43 real(kind=dk), allocatable :: compare_values(:)
44 integer :: i_elem, i_band
45 logical :: flag
46
47 call core_config%from_file( "core_config.json" )
48 core => core_t( core_config )
49
50 state_a => core%new_state( )
51 state_b => core%new_state( )
52
53 ! test state_t functions
54 call state_a%randomize( )
55 call state_b%randomize( )
56 call assert( 240883501, state_a%raw_size( ) .eq. state_b%raw_size( ) )
57 allocate( raw_state_a( state_a%raw_size( ) ) )
58 allocate( raw_state_b( state_b%raw_size( ) ) )
59 call state_a%dump_state( raw_state_a )
60 call state_b%dump_state( raw_state_b )
61 flag = .true.
62 do i_elem = 1, size( raw_state_a )
63 flag = flag .and. raw_state_a( i_elem ) .eq. raw_state_b( i_elem )
64 end do
65 call assert( 635677095, .not. flag )
66 call state_b%load_state( raw_state_a )
67 call state_b%dump_state( raw_state_b )
68 flag = .true.
69 do i_elem = 1, size( raw_state_a )
70 flag = flag .and. raw_state_a( i_elem ) .eq. raw_state_b( i_elem )
71 end do
72 call assert( 747995440, flag )
73 deallocate( raw_state_a )
74 deallocate( raw_state_b )
75
76 allocate( raw_state_a( state_a%raw_size( ) + 15 ) )
77 allocate( raw_state_b( state_b%raw_size( ) + 25 ) )
78 raw_state_a(:) = 12.5_dk
79 raw_state_b(:) = 43.1_dk
80 call state_a%randomize( )
81 call state_b%randomize( )
82 i_elem = 11
83 call state_a%dump_state( raw_state_a, i_elem )
84 call assert( 860313785, i_elem .eq. 11 + state_a%raw_size( ) )
85 i_elem = 16
86 call state_b%dump_state( raw_state_b, i_elem )
87 call assert( 690156881, i_elem .eq. 16 + state_b%raw_size( ) )
88 flag = .true.
89 do i_elem = 1, state_a%raw_size( )
90 flag = flag .and. raw_state_a( 10 + i_elem ) .eq. raw_state_b( 15 + i_elem )
91 end do
92 call assert( 519999977, .not. flag )
93 i_elem = 11
94 call state_b%load_state( raw_state_a, i_elem )
95 call assert( 632318322, i_elem .eq. 11 + state_b%raw_size( ) )
96 i_elem = 16
97 call state_a%dump_state( raw_state_b, i_elem )
98 call assert( 462161418, i_elem .eq. 16 + state_b%raw_size( ) )
99 flag = .true.
100 do i_elem = 1, state_a%raw_size( )
101 flag = flag .and. raw_state_a( 10 + i_elem ) .eq. raw_state_b( 15 + i_elem )
102 end do
103 call assert( 856955012, flag )
104 do i_elem = 1, 10
105 call assert( 673363016, raw_state_a( i_elem ) .eq. 12.5_dk )
106 end do
107 do i_elem = 11 + state_a%raw_size( ), 15 + state_a%raw_size( )
108 call assert( 686798108, raw_state_a( i_elem ) .eq. 12.5_dk )
109 end do
110 do i_elem = 1, 15
111 call assert( 681533801, raw_state_b( i_elem ) .eq. 43.1_dk )
112 end do
113 do i_elem = 16 + state_a%raw_size( ), 25 + state_a%raw_size( )
114 call assert( 511376897, raw_state_b( i_elem ) .eq. 43.1_dk )
115 end do
116
117 deallocate( raw_state_a )
118 deallocate( raw_state_b )
119
120 allocate( compare_values( 2 ) )
121 call env_state%randomize( )
122
123 ! get optics shortwave
124 call optics_config%empty( )
125 call optics_config%add( "type", 1, my_name )
126 mock_optics_lookup = optics_lookup_t( optics_config )
127 grid = wavelength_grid_t( (/ 12.3_dk, 100.0_dk /), &
128 (/ 92.3_dk, 1145.0_dk /) )
129 allocate( optics_values( grid%number_of_sections( ) ) )
130
131 ! scalar optics
132 prop = property_t( my_name, "asymmetry factor" )
133 optics => core%new_optics( prop, grid )
134 call assert( 842692121, optics%output_grid( ) .eq. grid )
135 call core%shortwave_optics( env_state, state_a, optics )
136 call optics%get_values( optics_values )
137 compare_values(:) = (/ 6.0_dk, 5.4_dk /) * 2
138 call assert( 267690901, size( optics_values ) .eq. size( compare_values ) )
139 do i_band = 1, size( optics_values )
140 call assert( 941600971, optics_values( i_band ) .gt. 0.0_dk )
141 call assert( 488968818, optics_values( i_band ) .lt. 1.0e200_dk )
142 call assert( 601287163, almost_equal( optics_values( i_band ), &
143 compare_values( i_band ) ) )
144 end do
145 deallocate( optics )
146
147 ! array optics
148 allocate( optics_set( 3 ) )
149 prop = property_t( my_name, "layer extinction optical depth" )
150 optics_set( 1 )%ptr_ => core%new_optics( prop, grid )
151 prop = property_t( my_name, "layer single-scatter albedo" )
152 optics_set( 2 )%ptr_ => core%new_optics( prop, grid )
153 prop = property_t( my_name, "forward scattered fraction" )
154 optics_set( 3 )%ptr_ => core%new_optics( prop, grid )
155 call core%shortwave_optics( env_state, state_a, optics_set )
156 call optics_set( 1 )%ptr_%get_values( optics_values )
157 compare_values(:) = (/ 2.0_dk, 8.5_dk /) * 2
158 do i_band = 1, size( optics_values )
159 call assert( 706799581, optics_values( i_band ) .gt. 0.0_dk )
160 call assert( 766543674, optics_values( i_band ) .lt. 1.0e200_dk )
161 call assert( 991180364, almost_equal( optics_values( i_band ), &
162 compare_values( i_band ) ) )
163 end do
164 call optics_set( 2 )%ptr_%get_values( optics_values )
165 compare_values(:) = (/ 4.0_dk, 1.8_dk /) * 2
166 do i_band = 1, size( optics_values )
167 call assert( 138490310, optics_values( i_band ) .gt. 0.0_dk )
168 call assert( 315817055, optics_values( i_band ) .lt. 1.0e200_dk )
169 call assert( 763184901, almost_equal( optics_values( i_band ), &
170 compare_values( i_band ) ) )
171 end do
172 call optics_set( 3 )%ptr_%get_values( optics_values )
173 compare_values(:) = (/ 8.0_dk, 3.2_dk /) * 2
174 do i_band = 1, size( optics_values )
175 call assert( 257978496, optics_values( i_band ) .gt. 0.0_dk )
176 call assert( 987821591, optics_values( i_band ) .lt. 1.0e200_dk )
177 call assert( 817664687, almost_equal( optics_values( i_band ), &
178 compare_values( i_band ) ) )
179 end do
180 deallocate( optics_set )
181 deallocate( optics_values )
182
183 ! get optics longwave
184 call optics_config%empty( )
185 call optics_config%add( "type", 2, my_name )
186 mock_optics_lookup = optics_lookup_t( optics_config )
187 grid = wavelength_grid_t( (/ 12.3_dk, 100.0_dk * 2 /), &
188 (/ 92.3_dk, 1145.0_dk * 2 /) )
189 allocate( optics_values( grid%number_of_sections( ) ) )
190
191 ! scalar get optics
192 prop = property_t( my_name, "layer absorption optical depth" )
193 optics => core%new_optics( prop, grid )
194 call assert( 516490039, optics%native_grid( ) .eq. &
195 mock_optics_lookup%grid( ) )
196 call assert( 346333135, optics%output_grid( ) .eq. grid )
197 call core%longwave_optics( env_state, state_a, optics )
198 call optics%get_values( optics_values )
199 compare_values(:) = (/ 20.0_dk, 82.5_dk /) * 2
200 call assert( 855350608, size( optics_values ) .eq. size( compare_values ) )
201 do i_band = 1, size( optics_values )
202 call assert( 402718455, optics_values( i_band ) .gt. 0.0_dk )
203 call assert( 850086301, optics_values( i_band ) .lt. 1.0e200_dk )
204 call assert( 397454148, almost_equal( optics_values( i_band ), &
205 compare_values( i_band ) ) )
206 end do
207
208 ! array get optics
209 allocate( optics_set( 1 ) )
210 optics_set( 1 )%ptr_ => optics
211 call core%longwave_optics( env_state, state_a, optics_set )
212 call optics_set( 1 )%ptr_%get_values( optics_values )
213 compare_values(:) = (/ 20.0_dk, 82.5_dk /) * 2
214 call assert( 339615589, size( optics_values ) .eq. size( compare_values ) )
215 do i_band = 1, size( optics_values )
216 call assert( 169458685, optics_values( i_band ) .gt. 0.0_dk )
217 call assert( 346785430, optics_values( i_band ) .lt. 1.0e200_dk )
218 call assert( 794153276, almost_equal( optics_values( i_band ), &
219 compare_values( i_band ) ) )
220 end do
221
222 deallocate( optics )
223 deallocate( optics_set )
224 deallocate( optics_values )
225 deallocate( state_a )
226 deallocate( state_b )
227
228 end subroutine test_core_t
229
230!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
231
232end program test_core
mam_core
The core_t type and related functions.
Definition: core.F90:8
mam_optics_lookup
The optics_lookup_t type and related functions.
Definition: optics_lookup.F90:8
mam_core::core_t
The Modal Aerosol Model core.
Definition: core.F90:21
mam_core::state_t
Modal aerosol state.
Definition: core.F90:41
mam_optics_lookup::optics_lookup_t
Definition: optics_lookup.F90:47
test_core
program test_core
Test program for the core_t type and related functions.
Definition: core.F90:8
test_core_t
subroutine test_core_t()
Definition: core.F90:19
Generated on Mon Aug 15 2022 15:01:05 for mam by doxygen 1.9.4