test_solve_em.F
References to this file elsewhere.
1
2 ! ----------------------------------------------------------------------
3 ! ----------------------------------------------------------------------
4
5 SUBROUTINE test_solve_em ( grid , config_flags , &
6 ! Actual arguments generated from Registry
7 #include "em_dummy_args.inc"
8 !
9 )
10
11
12 ! Driver layer modules
13 USE module_domain
14 USE module_configure
15 USE module_driver_constants
16 USE module_machine
17 USE module_tiles
18 USE module_dm
19 ! Mediation layer modules
20 ! Model layer modules
21 USE module_model_constants
22 USE module_small_step_em
23 USE module_em
24 USE module_big_step_utilities_em
25 USE module_bc
26 USE module_bc_em
27 USE module_solvedebug_em
28 USE module_physics_addtendc
29 USE module_diffusion_em
30 ! Registry generated module
31 USE module_state_description
32 USE module_radiation_driver
33 USE module_surface_driver
34 USE module_cumulus_driver
35 USE module_microphysics_driver
36 USE module_pbl_driver
37
38 USE g_module_small_step_em
39 USE g_module_em
40 USE g_module_big_step_utilities_em
41 USE g_module_bc
42 USE g_module_bc_em
43 USE g_module_diffusion_em
44
45 ! USE a_module_small_step_em
46 ! USE a_module_em
47 ! USE a_module_big_step_utilities_em
48 ! USE a_module_bc
49 ! USE a_module_bc_em
50 ! USE a_module_diffusion_em
51
52 IMPLICIT NONE
53
54 ! INTERFACE
55 ! include <../share/solve_em.int>
56 ! include <../share/solve_em_tl.int>
57 ! include <../share/solve_em_ad.int>
58 ! END INTERFACE
59
60 ! Input data.
61
62 TYPE(domain) , TARGET :: grid
63
64 ! Definitions of dummy arguments to this routine (generated from Registry).
65 #include <em_dummy_decl.inc>
66
67 ! Structure that contains run-time configuration (namelist) data for domain
68 TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
69
70 ! Local data
71
72 INTEGER :: k_start , k_end, its, ite, jts, jte
73 INTEGER :: ids , ide , jds , jde , kds , kde , &
74 ims , ime , jms , jme , kms , kme , &
75 ips , ipe , jps , jpe , kps , kpe
76 INTEGER :: ij , iteration
77 INTEGER :: im , num_3d_m , ic , num_3d_c
78 INTEGER :: loop
79 INTEGER :: ijds, ijde
80 INTEGER :: itmpstep
81 INTEGER :: sz
82
83 ! storage for tendencies and decoupled state (generated from Registry)
84 #include <em_i1_decl.inc>
85
86 INTEGER :: rc
87 INTEGER :: number_of_small_timesteps, rk_step
88 INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only
89 INTEGER :: idum1, idum2, dynamics_option
90
91 INTEGER :: rk_order, iwmax, jwmax, kwmax
92 REAL :: dt_rk, dts_rk, dtm, wmax
93 INTEGER :: l,kte,kk
94
95 ! These are used if -DDEREF_KLUDGE is compiled
96 ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
97 INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
98 INTEGER :: sm31x , em31x , sm32x , em32x , sm33x , em33x
99 INTEGER :: sm31y , em31y , sm32y , em32y , sm33y , em33y
100
101 !---------------------------------------------
102 !---------------------------------------------
103
104
105 INTEGER :: kts !zzma
106
107 !---------------------------------------------------------------------------------------
108 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_u_1
109 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_u_2
110 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ru
111 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ru_m
112 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ru_tend
113 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_u_save
114 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_v_1
115 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_v_2
116 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_rv
117 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_rv_m
118 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_rv_tend
119 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_v_save
120 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_w_1
121 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_w_2
122 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ww
123 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_rw
124 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ph_1
125 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_ph_2
126 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_phb
127 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_php
128 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_t_1
129 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_t_2
130 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_t_save
131 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_mu_1
132 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_mu_2
133 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_mub
134 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_mudf
135 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_muu
136 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_muv
137 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_mut
138 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: S_muts
139 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_p
140 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_al
141 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_alt
142 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_z
143 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: S_moist_1
144 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: S_moist_2
145 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_u_b
146 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_u_bt
147 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_v_b
148 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_v_bt
149 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_w_b
150 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_w_bt
151 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_ph_b
152 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_ph_bt
153 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_t_b
154 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_t_bt
155 real ,DIMENSION(max(grid%ed31,grid%ed33),1,grid%spec_bdy_width,4) :: S_mu_b
156 real ,DIMENSION(max(grid%ed31,grid%ed33),1,grid%spec_bdy_width,4) :: S_mu_bt
157 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqv_b
158 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqv_bt
159 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqc_b
160 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqc_bt
161 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqr_b
162 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqr_bt
163 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqi_b
164 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqi_bt
165 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqs_b
166 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqs_bt
167 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqg_b
168 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: S_rqg_bt
169 real ,DIMENSION(grid%spec_bdy_width) :: S_fcx
170 real ,DIMENSION(grid%spec_bdy_width) :: S_gcx
171 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: S_xkmhd
172
173
174 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_u_1
175 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_u_2
176 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ru
177 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ru_m
178 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ru_tend
179 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_u_save
180 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_v_1
181 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_v_2
182 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_rv
183 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_rv_m
184 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_rv_tend
185 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_v_save
186 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_w_1
187 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_w_2
188 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ww
189 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_rw
190 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ph_1
191 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_ph_2
192 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_phb
193 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_php
194 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_t_1
195 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_t_2
196 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_t_save
197 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_mu_1
198 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_mu_2
199 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_mub
200 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_mudf
201 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_muu
202 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_muv
203 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_mut
204 real ,DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: B_muts
205 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_p
206 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_al
207 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_alt
208 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_z
209 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: B_moist_1
210 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33,num_moist) :: B_moist_2
211 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_u_b
212 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_u_bt
213 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_v_b
214 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_v_bt
215 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_w_b
216 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_w_bt
217 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_ph_b
218 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_ph_bt
219 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_t_b
220 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_t_bt
221 real ,DIMENSION(max(grid%ed31,grid%ed33),1,grid%spec_bdy_width,4) :: B_mu_b
222 real ,DIMENSION(max(grid%ed31,grid%ed33),1,grid%spec_bdy_width,4) :: B_mu_bt
223 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqv_b
224 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqv_bt
225 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqc_b
226 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqc_bt
227 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqr_b
228 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqr_bt
229 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqi_b
230 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqi_bt
231 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqs_b
232 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqs_bt
233 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqg_b
234 real ,DIMENSION(max(grid%ed31,grid%ed33),grid%sd32:grid%ed32,grid%spec_bdy_width,4) :: B_rqg_bt
235 real ,DIMENSION(grid%spec_bdy_width) :: B_fcx
236 real ,DIMENSION(grid%spec_bdy_width) :: B_gcx
237 real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: B_xkmhd
238
239 !---------------------------------------------------------------------------------------
240 !---------------------------------------------------------------------------------------
241 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_cqu
242 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_phm
243 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_cqv
244 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_pm1
245 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_cqw
246 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_a
247 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_gamma
248 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_alpha
249 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_rho
250 !real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: a_c2a
251
252
253 !---------------------------------------------------------------------------------------
254 !---------------------------------------------------------------------------------------
255
256 REAL :: SAVE_L, COEF, ALPHA_M, FACTOR, VAL_N, VAL_L, VAL_A
257 INTEGER :: NT,h
258
259 ! Define benchmarking timers if -DBENCH is compiled
260 #include <bench_solve_em_def.h>
261
262 !----------------------
263 ! Executable statements
264 !----------------------
265
266 ! Trick problematic compilers into not performing copy-in/copy-out by adding
267 ! indices to array arguments in the CALL statements in this routine.
268 ! It has the effect of passing only the first element of the array, rather
269 ! than the entire array. See:
270 ! http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
271 #include "deref_kludge.h"
272 ! Limit the number of arguments if compiled with -DLIMIT_ARGS by copying
273 ! scalar (non-array) arguments out of the grid data structure into locally
274 ! defined copies (defined in em_dummy_decl.inc, above, as they are if they
275 ! are arguments). An equivalent include of em_scalar_derefs.inc appears
276 ! at the end of the routine to copy back any chnaged non-array values.
277 ! The definition of COPY_IN or COPY_OUT before the include defines the
278 ! direction of the copy. Em_scalar_derefs.inc is generated from Registry
279 #define COPY_IN
280 #include <em_scalar_derefs.inc>
281
282 ! Needed by some comm layers, e.g. RSL. If needed, nmm_data_calls.inc is
283 ! generated from the registry. The definition of REGISTER_I1 allows
284 ! I1 data to be communicated in this routine if necessary.
285 #ifdef DM_PARALLEL
286 # define REGISTER_I1
287 # include <em_data_calls.inc>
288 #endif
289
290 !<DESCRIPTION>
291 !<pre>
292 ! solve_em is the main driver for advancing a grid a single timestep.
293 ! It is a mediation-layer routine -> DM and SM calls are made where
294 ! needed for parallel processing.
295 !
296 ! solve_em can integrate the equations using 2 time-integration methods
297 !
298 ! - 3rd order Runge-Kutta time integration (recommended)
299 !
300 ! - 2nd order Runge-Kutta time integration
301 !
302 ! The main sections of solve_em are
303 !
304 ! (1) Runge-Kutta (RK) loop
305 !
306 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
307 ! model state variables during the first RK sub-step (loop)
308 !
309 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
310 !
311 ! (4) Scalar advance for moist and chem scalar variables (and TKE)
312 ! within the RK sub-steps.
313 !
314 ! (5) time-split physics (after the RK step), currently this includes
315 ! only microphyics
316 !
317 ! A more detailed description of these sections follows.
318 !</pre>
319 !</DESCRIPTION>
320
321 ! Initialize timers if compiled with -DBENCH
322 #include <bench_solve_em_init.h>
323
324 ! zzma: new definition end
325
326 its = grid%sp31-3 ; ite = grid%ep31+3
327 kts = grid%sp32 ; kte = grid%ep32
328 jts = grid%sp33-3 ; jte = grid%ep33+3
329 print*,'its =',its
330 print*,'ite =',ite
331
332 print*,'jts =',jts
333 print*,'jte =',jte
334
335 print*,'kts =',kts
336 print*,'kte =',kte
337 print*,'num_moist =',num_moist
338 print*,'grid%ed31 =',grid%ed31
339 print*,'grid%ed32 =',grid%ed32
340 print*,'grid%spec_bdy_width =',grid%spec_bdy_width
341
342 S_u_1 = u_1
343 S_u_2 = u_2
344 S_v_1 = v_1
345 S_v_2 = v_2
346 S_w_1 = w_1
347 S_w_2 = w_2
348 S_ph_1 = ph_1
349 S_ph_2 = ph_2
350 S_t_1 = t_1
351 S_t_2 = t_2
352 S_mu_1 = mu_1
353 S_mu_2 = mu_2
354 S_p = p
355 S_al = al
356 S_moist_1 = moist_1
357 S_moist_2 = moist_2
358 ! S_u_b = u_b
359 ! S_u_bt = u_bt
360 ! S_v_b = v_b
361 ! S_v_bt = v_bt
362 ! S_w_b = w_b
363 ! S_w_bt = w_bt
364 ! S_ph_b = ph_b
365 ! S_ph_bt = ph_bt
366 ! S_t_b = t_b
367 ! S_t_bt = t_bt
368 ! S_mu_b = mu_b
369 ! S_mu_bt = mu_bt
370 ! S_rqv_b = rqv_b
371 ! S_rqv_bt = rqv_bt
372
373 !-------------
374 ! goto 1234 !zzma
375 !-------------
376
377 !NLM
378
379 CALL solve_em ( grid , config_flags , &
380 ! Actual arguments generated from Registry
381 #include "em_dummy_args.inc"
382 !
383 )
384
385 do i=its,ite
386 do k=kts,kte
387 do j=jts,jte
388 B_u_1(i,k,j) = u_1(i,k,j)
389 B_u_2(i,k,j) = u_2(i,k,j)
390 B_v_1(i,k,j) = v_1(i,k,j)
391 B_v_2(i,k,j) = v_2(i,k,j)
392 B_w_1(i,k,j) = w_1(i,k,j)
393 B_w_2(i,k,j) = w_2(i,k,j)
394 B_ph_1(i,k,j) = ph_1(i,k,j)
395 B_ph_2(i,k,j) = ph_2(i,k,j)
396 B_t_1(i,k,j) = t_1(i,k,j)
397 B_t_2(i,k,j) = t_2(i,k,j)
398 B_p(i,k,j) = p(i,k,j)
399 B_al(i,k,j) = al(i,k,j)
400 B_z(i,k,j) = z(i,k,j)
401 enddo
402 enddo
403 enddo
404
405 do i=its,ite
406 do j=jts,jte
407 B_mu_1(i,j) =mu_1(i,j)
408 B_mu_2(i,j) =mu_2(i,j)
409 B_mudf(i,j) =mudf(i,j)
410 enddo
411 enddo
412
413 do i=its,ite
414 do k=kts,kte
415 do j=jts,jte
416 do h=1,num_moist
417 B_moist_1(i,k,j,h) =moist_1(i,k,j,h)
418 B_moist_2(i,k,j,h) =moist_2(i,k,j,h)
419 enddo
420 enddo
421 enddo
422 enddo
423
424 ! TCL
425
426 u_1 = S_u_1
427 u_2 = S_u_2
428 v_1 = S_v_1
429 v_2 = S_v_2
430 w_1 = S_w_1
431 w_2 = S_w_2
432 ph_1 = S_ph_1
433 ph_2 = S_ph_2
434 t_1 = S_t_1
435 t_2 = S_t_2
436 mu_1 = S_mu_1
437 mu_2 = S_mu_2
438 p = S_p
439 al = S_al
440 moist_1 = S_moist_1
441 moist_2 = S_moist_2
442 ! u_b = S_u_b
443 ! u_bt = S_u_bt
444 ! v_b = S_v_b
445 ! v_bt = S_v_bt
446 ! w_b = S_w_b
447 ! w_bt = S_w_bt
448 ! ph_b = S_ph_b
449 ! ph_bt = S_ph_bt
450 ! t_b = S_t_b
451 ! t_bt = S_t_bt
452 ! mu_b = S_mu_b
453 ! mu_bt = S_mu_bt
454 ! rqv_b = S_rqv_b
455 ! rqv_bt = S_rqv_bt
456
457
458 g_u_1 = u_1
459 g_u_2 = u_2
460 g_v_1 = v_1
461 g_v_2 = v_2
462 g_w_1 = w_1
463 g_w_2 = w_2
464 g_ph_1 = ph_1
465 g_ph_2 = ph_2
466 g_t_1 = t_1
467 g_t_2 = t_2
468 g_mu_1 = mu_1
469 g_mu_2 = mu_2
470 g_p = p
471 g_al = al
472 g_moist_1 = moist_1
473 g_moist_2 = moist_2
474 g_u_b = 0.0
475 g_u_bt = 0.0
476 g_v_b = 0.0
477 g_v_bt = 0.0
478 g_w_b = 0.0
479 g_w_bt = 0.0
480 g_ph_b = 0.0
481 g_ph_bt = 0.0
482 g_t_b = 0.0
483 g_t_bt = 0.0
484 g_mu_b = 0.0
485 g_mu_bt = 0.0
486 g_rqv_b = 0.0
487 g_rqv_bt = 0.0
488
489 CALL solve_em_tl ( grid , config_flags , &
490 ! Actual arguments generated from Registry
491 #include "em_actual_args.inc"
492 !
493 )
494
495 SAVE_L =0.0
496 do i=its,ite
497 do k=kts,kte
498 do j=jts,jte
499 SAVE_L =SAVE_L + g_u_1(i,k,j) * g_u_1(i,k,j) &
500 + g_u_2(i,k,j) * g_u_2(i,k,j) &
501 + g_v_1(i,k,j) * g_v_1(i,k,j) &
502 + g_v_2(i,k,j) * g_v_2(i,k,j) &
503 + g_w_1(i,k,j) * g_w_1(i,k,j) &
504 + g_w_2(i,k,j) * g_w_2(i,k,j) &
505 + g_ph_1(i,k,j) * g_ph_1(i,k,j) &
506 + g_ph_2(i,k,j) * g_ph_2(i,k,j) &
507 + g_t_1(i,k,j) * g_t_1(i,k,j) &
508 + g_t_2(i,k,j) * g_t_2(i,k,j) &
509 + g_p(i,k,j) * g_p(i,k,j) &
510 + g_al(i,k,j) * g_al(i,k,j) &
511 + g_z(i,k,j) * g_z(i,k,j)
512
513 enddo
514 enddo
515 enddo
516
517 do i=its,ite
518 do j=jts,jte
519 SAVE_L =SAVE_L + g_mu_1(i,j) * g_mu_1(i,j) &
520 + g_mu_2(i,j) * g_mu_2(i,j) &
521 + g_mudf(i,j) * g_mudf(i,j)
522 enddo
523 enddo
524 do i=its,ite
525 do k=kts,kte
526 do j=jts,jte
527 do h=1,num_moist
528 SAVE_L =SAVE_L + g_moist_1(i,k,j,h) * g_moist_1(i,k,j,h) &
529 + g_moist_2(i,k,j,h) * g_moist_2(i,k,j,h)
530 enddo
531 enddo
532 enddo
533 enddo
534
535 ALPHA_M=1.
536 DO NT=1,11
537 ALPHA_M=0.1*ALPHA_M
538 FACTOR=1.+ALPHA_M
539 u_1 = FACTOR*S_u_1
540 u_2 = FACTOR*S_u_2
541 v_1 = FACTOR*S_v_1
542 v_2 = FACTOR*S_v_2
543 w_1 = FACTOR*S_w_1
544 w_2 = FACTOR*S_w_2
545 ph_1 = FACTOR*S_ph_1
546 ph_2 = FACTOR*S_ph_2
547 t_1 = FACTOR*S_t_1
548 t_2 = FACTOR*S_t_2
549 mu_1 = FACTOR*S_mu_1
550 mu_2 = FACTOR*S_mu_2
551 p = FACTOR*S_p
552 al = FACTOR*S_al
553 moist_1 = FACTOR*S_moist_1
554 moist_2 = FACTOR*S_moist_2
555 ! u_b = FACTOR*S_u_b
556 ! u_bt = FACTOR*S_u_bt
557 ! v_b = FACTOR*S_v_b
558 ! v_bt = FACTOR*S_v_bt
559 ! w_b = FACTOR*S_w_b
560 ! w_bt = FACTOR*S_w_bt
561 ! ph_b = FACTOR*S_ph_b
562 ! ph_bt = FACTOR*S_ph_bt
563 ! t_b = FACTOR*S_t_b
564 ! t_bt = FACTOR*S_t_bt
565 ! mu_b = FACTOR*S_mu_b
566 ! mu_bt = FACTOR*S_mu_bt
567 ! rqv_b = FACTOR*S_rqv_b
568 ! rqv_bt = FACTOR*S_rqv_bt
569
570
571 CALL solve_em ( grid , config_flags , &
572 ! Actual arguments generated from Registry
573 #include "em_actual_args.inc"
574 !
575 )
576 VAL_N = 0.0
577
578 do i=its,ite
579 do k=kts,kte
580 do j=jts,jte
581 VAL_N=VAL_N + (u_1(i,k,j) - B_u_1(i,k,j) ) *(u_1(i,k,j) - B_u_1(i,k,j)) &
582 + (u_2(i,k,j) - B_u_2(i,k,j) ) *(u_2(i,k,j) - B_u_2(i,k,j)) &
583 + (v_1(i,k,j) - B_v_1(i,k,j) ) *(v_1(i,k,j) - B_v_1(i,k,j)) &
584 + (v_2(i,k,j) - B_v_2(i,k,j) ) *(v_2(i,k,j) - B_v_2(i,k,j)) &
585 + (w_1(i,k,j) - B_w_1(i,k,j) ) *(w_1(i,k,j) - B_w_1(i,k,j)) &
586 + (w_2(i,k,j) - B_w_2(i,k,j) ) *(w_2(i,k,j) - B_w_2(i,k,j)) &
587 + (ph_1(i,k,j) - B_ph_1(i,k,j) ) *(ph_1(i,k,j) - B_ph_1(i,k,j)) &
588 + (ph_2(i,k,j) - B_ph_2(i,k,j) ) *(ph_2(i,k,j) - B_ph_2(i,k,j)) &
589 + (t_1(i,k,j) - B_t_1(i,k,j) ) *(t_1(i,k,j) - B_t_1(i,k,j)) &
590 + (t_2(i,k,j) - B_t_2(i,k,j) ) *(t_2(i,k,j) - B_t_2(i,k,j)) &
591 + (p(i,k,j) - B_p(i,k,j) ) *(p(i,k,j) - B_p(i,k,j)) &
592 + (al(i,k,j) - B_al(i,k,j) ) *(al(i,k,j) - B_al(i,k,j)) &
593 + (z(i,k,j) - B_z(i,k,j) ) *(z(i,k,j) - B_z(i,k,j))
594 enddo
595 enddo
596 enddo
597
598
599 do i=its,ite
600 do j=jts,jte
601 VAL_N=VAL_N + (mu_1(i,j) -B_mu_1(i,j))*(mu_1(i,j) -B_mu_1(i,j)) &
602 + (mu_2(i,j) -B_mu_2(i,j))*(mu_2(i,j) -B_mu_2(i,j)) &
603 + (mudf(i,j) -B_mudf(i,j))*(mudf(i,j) -B_mudf(i,j))
604 enddo
605 enddo
606 do i=its,ite
607 do k=kts,kte
608 do j=jts,jte
609 do h=1,num_moist
610 VAL_N=VAL_N + (moist_1(i,k,j,h) -B_moist_1(i,k,j,h))*(moist_1(i,k,j,h) -B_moist_1(i,k,j,h)) &
611 + (moist_2(i,k,j,h) -B_moist_2(i,k,j,h))*(moist_2(i,k,j,h) -B_moist_2(i,k,j,h))
612 enddo
613 enddo
614 enddo
615 enddo
616
617 VAL_L=SAVE_L*ALPHA_M**2
618 COEF=VAL_N/VAL_L
619 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
620 'g_em_sn: ALPHA_M=',ALPHA_M,' COEF=',COEF, &
621 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
622 ENDDO
623
624 ! ADJ test
625 !-------------
626 !1234 continue !zzma
627 !-------------
628
629 FACTOR=0.1
630
631 u_1 = S_u_1
632 u_2 = S_u_2
633 v_1 = S_v_1
634 v_2 = S_v_2
635 w_1 = S_w_1
636 w_2 = S_w_2
637 ph_1 = S_ph_1
638 ph_2 = S_ph_2
639 t_1 = S_t_1
640 t_2 = S_t_2
641 mu_1 = S_mu_1
642 mu_2 = S_mu_2
643 p = S_p
644 al = S_al
645 moist_1 = S_moist_1
646 moist_2 = S_moist_2
647 ! u_b = S_u_b
648 ! u_bt = S_u_bt
649 ! v_b = S_v_b
650 ! v_bt = S_v_bt
651 ! w_b = S_w_b
652 ! w_bt = S_w_bt
653 ! ph_b = S_ph_b
654 ! ph_bt = S_ph_bt
655 ! t_b = S_t_b
656 ! t_bt = S_t_bt
657 ! mu_b = S_mu_b
658 ! mu_bt = S_mu_bt
659 ! rqv_b = S_rqv_b
660 ! rqv_bt = S_rqv_bt
661
662
663
664
665 g_u_1 = FACTOR*S_u_1
666 g_u_2 = FACTOR*S_u_2
667 g_v_1 = FACTOR*S_v_1
668 g_v_2 = FACTOR*S_v_2
669 g_w_1 = FACTOR*S_w_1
670 g_w_2 = FACTOR*S_w_2
671 g_ph_1 = FACTOR*S_ph_1
672 g_ph_2 = FACTOR*S_ph_2
673 g_t_1 = FACTOR*S_t_1
674 g_t_2 = FACTOR*S_t_2
675 g_mu_1 = FACTOR*S_mu_1
676 g_mu_2 = FACTOR*S_mu_2
677 g_p = FACTOR*S_p
678 g_al = FACTOR*S_al
679 g_moist_1 = FACTOR*S_moist_1
680 g_moist_2 = FACTOR*S_moist_2
681 ! g_u_b = FACTOR*S_u_b
682 ! g_u_bt = FACTOR*S_u_bt
683 ! g_v_b = FACTOR*S_v_b
684 ! g_v_bt = FACTOR*S_v_bt
685 ! g_w_b = FACTOR*S_w_b
686 ! g_w_bt = FACTOR*S_w_bt
687 ! g_ph_b = FACTOR*S_ph_b
688 ! g_ph_bt = FACTOR*S_ph_bt
689 ! g_t_b = FACTOR*S_t_b
690 ! g_t_bt = FACTOR*S_t_bt
691 ! g_mu_b = FACTOR*S_mu_b
692 ! g_mu_bt = FACTOR*S_mu_bt
693 ! g_rqv_b = FACTOR*S_rqv_b
694 ! g_rqv_bt = FACTOR*S_rqv_bt
695
696 g_u_b = 0.
697 g_u_bt =0.
698 g_v_b = 0.
699 g_v_bt =0.
700 g_w_b = 0.
701 g_w_bt =0.
702 g_ph_b =0.
703 g_ph_bt =0.
704 g_t_b = 0.
705 g_t_bt =0.
706 g_mu_b =0.
707 g_mu_bt =0.
708 g_rqv_b =0.
709 g_rqv_bt =0.
710
711
712 ! g_u_1 =0.0
713 ! g_v_1 =0.0
714 ! g_w_1 =0.0
715 ! g_ph_1 =0.0
716 ! g_t_1 = 0.0
717 ! g_moist_1 =0.0
718 ! g_w_2 = 0.0
719 ! g_mu_1 =0.0
720
721 ! g_u_2 =0.0
722 ! g_v_2 =0.0
723 ! g_ph_2 =0.0
724 ! g_t_2 =0.0
725
726 ! g_mu_2 = 0.0
727 ! g_p = 0.0
728 ! g_al = 0.0
729 ! g_moist_2 = 0.0
730
731 B_u_1 = g_u_1
732 B_u_2 = g_u_2
733 B_v_1 = g_v_1
734 B_v_2 = g_v_2
735 B_w_1 = g_w_1
736 B_w_2 = g_w_2
737 B_ph_1 = g_ph_1
738 B_ph_2 = g_ph_2
739 B_t_1 = g_t_1
740 B_t_2 = g_t_2
741 B_mu_1 = g_mu_1
742 B_mu_2 = g_mu_2
743 B_p = g_p
744 B_al = g_al
745 B_moist_1 = g_moist_1
746 B_moist_2 = g_moist_2
747 ! B_u_b = g_u_b
748 ! B_u_bt = g_u_bt
749 ! B_v_b = g_v_b
750 ! B_v_bt = g_v_bt
751 ! B_w_b = g_w_b
752 ! B_w_bt = g_w_bt
753 ! B_ph_b = g_ph_b
754 ! B_ph_bt = g_ph_bt
755 ! B_t_b = g_t_b
756 ! B_t_bt = g_t_bt
757 ! B_mu_b = g_mu_b
758 ! B_mu_bt = g_mu_bt
759 ! B_rqv_b = g_rqv_b
760 ! B_rqv_bt = g_rqv_bt
761
762
763 CALL solve_em_tl ( grid , config_flags , &
764 ! Actual arguments generated from Registry
765 #include "em_dummy_args.inc"
766 !
767 )
768
769 g_z=0.; g_mudf=0.
770
771 VAL_L =0.0
772 do i=its,ite
773 do k=kts,kte
774 do j=jts,jte
775 VAL_L =VAL_L + g_u_1(i,k,j) * g_u_1(i,k,j) &
776 + g_u_2(i,k,j) * g_u_2(i,k,j) &
777 + g_v_1(i,k,j) * g_v_1(i,k,j) &
778 + g_v_2(i,k,j) * g_v_2(i,k,j) &
779 + g_w_1(i,k,j) * g_w_1(i,k,j) &
780 + g_w_2(i,k,j) * g_w_2(i,k,j) &
781 + g_ph_1(i,k,j) * g_ph_1(i,k,j) &
782 + g_ph_2(i,k,j) * g_ph_2(i,k,j) &
783 + g_t_1(i,k,j) * g_t_1(i,k,j) &
784 + g_t_2(i,k,j) * g_t_2(i,k,j) &
785 + g_p(i,k,j) * g_p(i,k,j) &
786 + g_al(i,k,j) * g_al(i,k,j) &
787 + g_z(i,k,j) * g_z(i,k,j)
788
789 enddo
790 enddo
791 enddo
792
793 do i=its,ite
794 do j=jts,jte
795 VAL_L =VAL_L + g_mu_1(i,j) * g_mu_1(i,j) &
796 + g_mu_2(i,j) * g_mu_2(i,j) &
797 + g_mudf(i,j) * g_mudf(i,j)
798 enddo
799 enddo
800 do i=its,ite
801 do k=kts,kte
802 do j=jts,jte
803 do h=1,num_moist
804 VAL_L =VAL_L + g_moist_1(i,k,j,h) * g_moist_1(i,k,j,h) &
805 + g_moist_2(i,k,j,h) * g_moist_2(i,k,j,h)
806 enddo
807 enddo
808 enddo
809 enddo
810
811
812 ! ADJ
813
814 u_1 = S_u_1
815 u_2 = S_u_2
816 v_1 = S_v_1
817 v_2 = S_v_2
818 w_1 = S_w_1
819 w_2 = S_w_2
820 ph_1 = S_ph_1
821 ph_2 = S_ph_2
822 t_1 = S_t_1
823 t_2 = S_t_2
824 mu_1 = S_mu_1
825 mu_2 = S_mu_2
826 p = S_p
827 al = S_al
828 moist_1 = S_moist_1
829 moist_2 = S_moist_2
830 ! u_b = S_u_b
831 ! u_bt = S_u_bt
832 ! v_b = S_v_b
833 ! v_bt = S_v_bt
834 ! w_b = S_w_b
835 ! w_bt = S_w_bt
836 ! ph_b = S_ph_b
837 ! ph_bt = S_ph_bt
838 ! t_b = S_t_b
839 ! t_bt = S_t_bt
840 ! mu_b = S_mu_b
841 ! mu_bt = S_mu_bt
842 ! rqv_b = S_rqv_b
843 ! rqv_bt = S_rqv_bt
844
845
846
847
848 a_u_1 = 0.
849 a_u_2 = 0.
850 a_v_1 = 0.
851 a_v_2 =0.
852 a_w_1 =0.
853 a_w_2 =0.
854 a_ph_1 =0.
855 a_ph_2 = 0.
856 a_t_1 = 0.
857 a_t_2 =0.
858 a_mu_1 = 0.
859 a_mu_2 =0.
860 a_p = 0.
861 a_al =0.
862 a_moist_1 = 0.
863 a_moist_2 =0.
864 a_u_b = 0.
865 a_u_bt = 0.
866 a_v_b = 0.
867 a_v_bt =0.
868 a_w_b = 0.
869 a_w_bt =0.
870 a_ph_b =0.
871 a_ph_bt =0.
872 a_t_b = 0.
873 a_t_bt =0.
874 a_mu_b =0.
875 a_mu_bt =0.
876 a_rqv_b =0.
877 a_rqv_bt =0.
878
879 a_u_1 = g_u_1
880 a_u_2 = g_u_2
881 a_v_1 = g_v_1
882 a_v_2 = g_v_2
883 a_w_1 = g_w_1
884 a_w_2 = g_w_2
885 a_ph_1 = g_ph_1
886 a_ph_2 = g_ph_2
887 a_t_1 = g_t_1
888 a_t_2 = g_t_2
889 a_mu_1 = g_mu_1
890 a_mu_2 = g_mu_2
891 a_mudf = g_mudf
892 a_p = g_p
893 a_al = g_al
894 a_z = g_z
895 a_moist_1 = g_moist_1
896 a_moist_2 = g_moist_2
897
898 CALL solve_em_ad ( grid , config_flags , &
899 !
900 #include "em_dummy_args.inc"
901 !
902 )
903
904 VAL_A=0.0
905
906 do i=its,ite
907 do k=kts,kte
908 do j=jts,jte
909 VAL_A= VAL_A + a_u_1(i,k,j) * B_u_1(i,k,j) &
910 + a_u_2(i,k,j) * B_u_2(i,k,j) &
911 + a_v_1(i,k,j) * B_v_1(i,k,j) &
912 + a_v_2(i,k,j) * B_v_2(i,k,j) &
913 + a_w_1(i,k,j) * B_w_1(i,k,j) &
914 + a_w_2(i,k,j) * B_w_2(i,k,j) &
915 + a_ph_1(i,k,j) * B_ph_1(i,k,j) &
916 + a_ph_2(i,k,j) * B_ph_2(i,k,j) &
917 + a_t_1(i,k,j) * B_t_1(i,k,j) &
918 + a_t_2(i,k,j) * B_t_2(i,k,j) &
919 + a_p(i,k,j) * B_p(i,k,j) &
920 + a_al(i,k,j) * B_al(i,k,j)
921
922 enddo
923 enddo
924 enddo
925 do i=its,ite
926 do j=jts,jte
927 VAL_A= VAL_A + a_mu_1(i,j) * B_mu_1(i,j) &
928 + a_mu_2(i,j) * B_mu_2(i,j)
929 enddo
930 enddo
931 do i=its,ite
932 do k=kts,kte
933 do j=jts,jte
934 do h=1,num_moist
935 VAL_A= VAL_A + a_moist_1(i,k,j,h) * B_moist_1(i,k,j,h) &
936 + a_moist_2(i,k,j,h) * B_moist_2(i,k,j,h)
937 enddo
938 enddo
939 enddo
940 enddo
941 do i=1,max(grid%ed31,grid%ed33)
942 do k=kts,kte
943 do j=1,grid%spec_bdy_width
944 do h=1,4
945 ! VAL_A= VAL_A + a_u_b(i,k,j,h) * B_u_b(i,k,j,h) &
946 ! + a_u_bt(i,k,j,h) * B_u_bt(i,k,j,h) &
947 ! + a_v_b(i,k,j,h) * B_v_b(i,k,j,h) &
948 ! + a_v_bt(i,k,j,h) * B_v_bt(i,k,j,h) &
949 ! + a_w_b(i,k,j,h) * B_w_b(i,k,j,h) &
950 ! + a_w_bt(i,k,j,h) * B_w_bt(i,k,j,h) &
951 ! + a_ph_b(i,k,j,h) * B_ph_b(i,k,j,h) &
952 ! + a_ph_bt(i,k,j,h) * B_ph_bt(i,k,j,h) &
953 ! + a_t_b(i,k,j,h) * B_t_b(i,k,j,h) &
954 ! + a_t_bt(i,k,j,h) * B_t_bt(i,k,j,h) &
955 ! + a_mu_b(i,k,j,h) * B_mu_b(i,k,j,h) &
956 ! + a_mu_bt(i,k,j,h) * B_mu_bt(i,k,j,h) &
957 ! + a_rqv_b(i,k,j,h) * B_rqv_b(i,k,j,h) &
958 ! + a_rqv_bt(i,k,j,h) * B_rqv_bt(i,k,j,h)
959 enddo
960 enddo
961 enddo
962 enddo
963
964 print*, ' '
965 write(6,*) 'a_em: '
966 write(6,fmt='(A,E22.13)') ' VAL_TL: ', VAL_L
967 write(6,fmt='(A,E22.13)') ' VAL_AD: ', VAL_A
968
969 ! RECOVER
970
971 u_1 = S_u_1
972 u_2 = S_u_2
973 ru = S_ru
974 ru_m = S_ru_m
975 ru_tend = S_ru_tend
976 u_save = S_u_save
977 v_1 = S_v_1
978 v_2 = S_v_2
979 rv = S_rv
980 rv_m = S_rv_m
981 rv_tend = S_rv_tend
982 v_save = S_v_save
983 w_1 = S_w_1
984 w_2 = S_w_2
985 ww = S_ww
986 rw = S_rw
987 ph_1 = S_ph_1
988 ph_2 = S_ph_2
989 phb = S_phb
990 php = S_php
991 t_1 = S_t_1
992 t_2 = S_t_2
993 t_save = S_t_save
994 mu_1 = S_mu_1
995 mu_2 = S_mu_2
996 mub = S_mub
997 mudf = S_mudf
998 muu = S_muu
999 muv = S_muv
1000 mut = S_mut
1001 muts = S_muts
1002 p = S_p
1003 al = S_al
1004 alt = S_alt
1005 z = S_z
1006 moist_1 = S_moist_1
1007 moist_2 = S_moist_2
1008 u_b = S_u_b
1009 u_bt = S_u_bt
1010 v_b = S_v_b
1011 v_bt = S_v_bt
1012 w_b = S_w_b
1013 w_bt = S_w_bt
1014 ph_b = S_ph_b
1015 ph_bt = S_ph_bt
1016 t_b = S_t_b
1017 t_bt = S_t_bt
1018 mu_b = S_mu_b
1019 mu_bt = S_mu_bt
1020 rqv_b = S_rqv_b
1021 rqv_bt = S_rqv_bt
1022 rqc_b = S_rqc_b
1023 rqc_bt = S_rqc_bt
1024 rqr_b = S_rqr_b
1025 rqr_bt = S_rqr_bt
1026 rqi_b = S_rqi_b
1027 rqi_bt = S_rqi_bt
1028 rqs_b = S_rqs_b
1029 rqs_bt = S_rqs_bt
1030 rqg_b = S_rqg_b
1031 rqg_bt = S_rqg_bt
1032 fcx = S_fcx
1033 gcx = S_gcx
1034 xkmhd = S_xkmhd
1035 !***********************************************************
1036 !***********************************************************
1037 !g_em_sn: ALPHA_M=.1000E+00 COEF= 0.1002139921065E+01 VAL_N= 0.106907E+12 VAL_L= 0.106679E+12
1038 !g_em_sn: ALPHA_M=.1000E-01 COEF= 0.1000033706173E+01 VAL_N= 0.106683E+10 VAL_L= 0.106679E+10
1039 !g_em_sn: ALPHA_M=.1000E-02 COEF= 0.9998179439761E+00 VAL_N= 0.106660E+08 VAL_L= 0.106679E+08
1040 !g_em_sn: ALPHA_M=.1000E-03 COEF= 0.9997966495443E+00 VAL_N= 0.106657E+06 VAL_L= 0.106679E+06
1041 !g_em_sn: ALPHA_M=.1000E-04 COEF= 0.9997944894996E+00 VAL_N= 0.106657E+04 VAL_L= 0.106679E+04
1042 !g_em_sn: ALPHA_M=.1000E-05 COEF= 0.9997942733074E+00 VAL_N= 0.106657E+02 VAL_L= 0.106679E+02
1043 !g_em_sn: ALPHA_M=.1000E-06 COEF= 0.9997942529592E+00 VAL_N= 0.106657E+00 VAL_L= 0.106679E+00
1044 !g_em_sn: ALPHA_M=.1000E-07 COEF= 0.9997942382646E+00 VAL_N= 0.106657E-02 VAL_L= 0.106679E-02
1045 !g_em_sn: ALPHA_M=.1000E-08 COEF= 0.9997943929116E+00 VAL_N= 0.106657E-04 VAL_L= 0.106679E-04
1046 !g_em_sn: ALPHA_M=.1000E-09 COEF= 0.9997942529716E+00 VAL_N= 0.106657E-06 VAL_L= 0.106679E-06
1047 !g_em_sn: ALPHA_M=.1000E-10 COEF= 0.9997953239580E+00 VAL_N= 0.106657E-08 VAL_L= 0.106679E-08
1048
1049 ! a_em:
1050 ! VAL_TL: 0.1065110571042E+12
1051 ! VAL_AD: 0.1065110571042E+12
1052 !***********************************************************
1053 !***********************************************************
1054 !---------------------------------------------------------------------------------------
1055
1056 END SUBROUTINE test_solve_em
1057
1058
1059