Home

Context Navigation

source: palm/trunk/SOURCE/prognostic_equations.f90 @ 2995

Last change on this file since 2995 was 2815, checked in by kanani, 7 years ago
Enable restarts and vector optimization for chemistry model
Property svn:keywords set to `Id`
File size: 94.3 KB

Line
1	!> @file prognostic_equations.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2018 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: prognostic_equations.f90 2815 2018-02-19 11:29:57Z Giersch $
27	! Rename chem_tendency to chem_prognostic_equations,
28	! implement vector version for air chemistry
29	!
30	! 2766 2018-01-22 17:17:47Z kanani
31	! Removed preprocessor directive __chem
32	!
33	! 2746 2018-01-15 12:06:04Z suehring
34	! Move flag plant canopy to modules
35	!
36	! 2719 2018-01-02 09:02:06Z maronga
37	! Bugfix for last change.
38	!
39	! 2718 2018-01-02 08:49:38Z maronga
40	! Corrected "Former revisions" section
41	!
42	! 2696 2017-12-14 17:12:51Z kanani
43	! - Change in file header (GPL part)
44	! - Moved TKE equation to tcm_prognostic (TG)
45	! - Added switch for chemical reactions (RF, FK)
46	! - Implementation of chemistry module (RF, BK, FK)
47	!
48	! 2563 2017-10-19 15:36:10Z Giersch
49	! Variable wind_turbine moved to module control_parameters
50	!
51	! 2320 2017-07-21 12:47:43Z suehring
52	! Modularize large-scale forcing and nudging
53	!
54	! 2292 2017-06-20 09:51:42Z schwenkel
55	! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
56	! includes two more prognostic equations for cloud drop concentration (nc)
57	! and cloud water content (qc).
58	!
59	! 2261 2017-06-08 14:25:57Z raasch
60	! bugfix for r2232: openmp directives removed
61	!
62	! 2233 2017-05-30 18:08:54Z suehring
63	!
64	! 2232 2017-05-30 17:47:52Z suehring
65	! Adjutst to new surface-type structure. Remove call for usm_wall_heat_flux,
66	! which is realized directly in diffusion_s now.
67	!
68	! 2192 2017-03-22 04:14:10Z raasch
69	! Bugfix for misplaced and missing openMP directives from r2155
70	!
71	! 2155 2017-02-21 09:57:40Z hoffmann
72	! Bugfix in the calculation of microphysical quantities on ghost points.
73	!
74	! 2118 2017-01-17 16:38:49Z raasch
75	! OpenACC version of subroutine removed
76	!
77	! 2031 2016-10-21 15:11:58Z knoop
78	! renamed variable rho to rho_ocean
79	!
80	! 2011 2016-09-19 17:29:57Z kanani
81	! Flag urban_surface is now defined in module control_parameters.
82	!
83	! 2007 2016-08-24 15:47:17Z kanani
84	! Added pt tendency calculation based on energy balance at urban surfaces
85	! (new urban surface model)
86	!
87	! 2000 2016-08-20 18:09:15Z knoop
88	! Forced header and separation lines into 80 columns
89	!
90	! 1976 2016-07-27 13:28:04Z maronga
91	! Simplied calls to radiation model
92	!
93	! 1960 2016-07-12 16:34:24Z suehring
94	! Separate humidity and passive scalar
95	!
96	! 1914 2016-05-26 14:44:07Z witha
97	! Added calls for wind turbine model
98	!
99	! 1873 2016-04-18 14:50:06Z maronga
100	! Module renamed (removed _mod)
101	!
102	! 1850 2016-04-08 13:29:27Z maronga
103	! Module renamed
104	!
105	! 1826 2016-04-07 12:01:39Z maronga
106	! Renamed canopy model calls.
107	!
108	! 1822 2016-04-07 07:49:42Z hoffmann
109	! Kessler microphysics scheme moved to microphysics.
110	!
111	! 1757 2016-02-22 15:49:32Z maronga
112	!
113	! 1691 2015-10-26 16:17:44Z maronga
114	! Added optional model spin-up without radiation / land surface model calls.
115	! Formatting corrections.
116	!
117	! 1682 2015-10-07 23:56:08Z knoop
118	! Code annotations made doxygen readable
119	!
120	! 1585 2015-04-30 07:05:52Z maronga
121	! Added call for temperature tendency calculation due to radiative flux divergence
122	!
123	! 1517 2015-01-07 19:12:25Z hoffmann
124	! advec_s_bc_mod addded, since advec_s_bc is now a module
125	!
126	! 1496 2014-12-02 17:25:50Z maronga
127	! Renamed "radiation" -> "cloud_top_radiation"
128	!
129	! 1484 2014-10-21 10:53:05Z kanani
130	! Changes due to new module structure of the plant canopy model:
131	! parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
132	! Removed double-listing of use_upstream_for_tke in ONLY-list of module
133	! control_parameters
134	!
135	! 1409 2014-05-23 12:11:32Z suehring
136	! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary.
137	! This ensures that left-hand side fluxes are also calculated for nxl in that
138	! case, even though the solution at nxl is overwritten in boundary_conds()
139	!
140	! 1398 2014-05-07 11:15:00Z heinze
141	! Rayleigh-damping for horizontal velocity components changed: instead of damping
142	! against ug and vg, damping against u_init and v_init is used to allow for a
143	! homogenized treatment in case of nudging
144	!
145	! 1380 2014-04-28 12:40:45Z heinze
146	! Change order of calls for scalar prognostic quantities:
147	! ls_advec -> nudging -> subsidence since initial profiles
148	!
149	! 1374 2014-04-25 12:55:07Z raasch
150	! missing variables added to ONLY lists
151	!
152	! 1365 2014-04-22 15:03:56Z boeske
153	! Calls of ls_advec for large scale advection added,
154	! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
155	! new argument ls_index added to the calls of subsidence
156	! +ls_index
157	!
158	! 1361 2014-04-16 15:17:48Z hoffmann
159	! Two-moment microphysics moved to the start of prognostic equations. This makes
160	! the 3d arrays for tend_q, tend_qr, tend_pt and tend_pt redundant.
161	! Additionally, it is allowed to call the microphysics just once during the time
162	! step (not at each sub-time step).
163	!
164	! Two-moment cloud physics added for vector and accelerator optimization.
165	!
166	! 1353 2014-04-08 15:21:23Z heinze
167	! REAL constants provided with KIND-attribute
168	!
169	! 1337 2014-03-25 15:11:48Z heinze
170	! Bugfix: REAL constants provided with KIND-attribute
171	!
172	! 1332 2014-03-25 11:59:43Z suehring
173	! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke
174	!
175	! 1330 2014-03-24 17:29:32Z suehring
176	! In case of SGS-particle velocity advection of TKE is also allowed with
177	! dissipative 5th-order scheme.
178	!
179	! 1320 2014-03-20 08:40:49Z raasch
180	! ONLY-attribute added to USE-statements,
181	! kind-parameters added to all INTEGER and REAL declaration statements,
182	! kinds are defined in new module kinds,
183	! old module precision_kind is removed,
184	! revision history before 2012 removed,
185	! comment fields (!:) to be used for variable explanations added to
186	! all variable declaration statements
187	!
188	! 1318 2014-03-17 13:35:16Z raasch
189	! module interfaces removed
190	!
191	! 1257 2013-11-08 15:18:40Z raasch
192	! openacc loop vector clauses removed, independent clauses added
193	!
194	! 1246 2013-11-01 08:59:45Z heinze
195	! enable nudging also for accelerator version
196	!
197	! 1241 2013-10-30 11:36:58Z heinze
198	! usage of nudging enabled (so far not implemented for accelerator version)
199	!
200	! 1179 2013-06-14 05:57:58Z raasch
201	! two arguments removed from routine buoyancy, ref_state updated on device
202	!
203	! 1128 2013-04-12 06:19:32Z raasch
204	! those parts requiring global communication moved to time_integration,
205	! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
206	! j_north
207	!
208	! 1115 2013-03-26 18:16:16Z hoffmann
209	! optimized cloud physics: calculation of microphysical tendencies transfered
210	! to microphysics.f90; qr and nr are only calculated if precipitation is required
211	!
212	! 1111 2013-03-08 23:54:10Z raasch
213	! update directives for prognostic quantities removed
214	!
215	! 1106 2013-03-04 05:31:38Z raasch
216	! small changes in code formatting
217	!
218	! 1092 2013-02-02 11:24:22Z raasch
219	! unused variables removed
220	!
221	! 1053 2012-11-13 17:11:03Z hoffmann
222	! implementation of two new prognostic equations for rain drop concentration (nr)
223	! and rain water content (qr)
224	!
225	! currently, only available for cache loop optimization
226	!
227	! 1036 2012-10-22 13:43:42Z raasch
228	! code put under GPL (PALM 3.9)
229	!
230	! 1019 2012-09-28 06:46:45Z raasch
231	! non-optimized version of prognostic_equations removed
232	!
233	! 1015 2012-09-27 09:23:24Z raasch
234	! new branch prognostic_equations_acc
235	! OpenACC statements added + code changes required for GPU optimization
236	!
237	! 1001 2012-09-13 14:08:46Z raasch
238	! all actions concerning leapfrog- and upstream-spline-scheme removed
239	!
240	! 978 2012-08-09 08:28:32Z fricke
241	! km_damp_x and km_damp_y removed in calls of diffusion_u and diffusion_v
242	! add ptdf_x, ptdf_y for damping the potential temperature at the inflow
243	! boundary in case of non-cyclic lateral boundaries
244	! Bugfix: first thread index changes for WS-scheme at the inflow
245	!
246	! 940 2012-07-09 14:31:00Z raasch
247	! temperature equation can be switched off
248	!
249	! Revision 1.1 2000/04/13 14:56:27 schroeter
250	! Initial revision
251	!
252	!
253	! Description:
254	! ------------
255	!> Solving the prognostic equations.
256	!------------------------------------------------------------------------------!
257	MODULE prognostic_equations_mod
258
259
260
261	USE arrays_3d, &
262	ONLY: diss_l_e, diss_l_nc, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qc, &
263	diss_l_qr, diss_l_s, diss_l_sa, diss_s_e, diss_s_nc, diss_s_nr, &
264	diss_s_pt, diss_s_q, diss_s_qc, diss_s_qr, diss_s_s, diss_s_sa, &
265	e, e_p, flux_s_e, flux_s_nc, flux_s_nr, flux_s_pt, flux_s_q, &
266	flux_s_qc, flux_s_qr, flux_s_s, flux_s_sa, flux_l_e, flux_l_nc, &
267	flux_l_nr, flux_l_pt, flux_l_q, flux_l_qc, flux_l_qr, flux_l_s, &
268	flux_l_sa, nc, nc_p, nr, nr_p, pt, ptdf_x, ptdf_y, pt_init, &
269	pt_p, prho, q, q_init, q_p, qc, qc_p, qr, qr_p, rdf, rdf_sc, &
270	ref_state, rho_ocean, s, s_init, s_p, sa, sa_init, sa_p, tend, &
271	te_m, tnc_m, tnr_m, tpt_m, tq_m, tqc_m, tqr_m, ts_m, tsa_m, &
272	tu_m, tv_m, tw_m, u, ug, u_init, u_p, v, vg, vpt, v_init, v_p, &
273	w, w_p
274
275	USE chemistry_model_mod, &
276	ONLY: chem_integrate, chem_prognostic_equations, &
277	chem_species, nspec, nvar, spc_names
278
279	USE chem_photolysis_mod, &
280	ONLY: photolysis_control
281
282	USE chem_modules, &
283	ONLY: call_chem_at_all_substeps, chem_gasphase_on
284
285	USE control_parameters, &
286	ONLY: air_chemistry, call_microphysics_at_all_substeps, &
287	cloud_physics, cloud_top_radiation, constant_diffusion, &
288	dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, &
289	humidity, &
290	inflow_l, intermediate_timestep_count, &
291	intermediate_timestep_count_max, large_scale_forcing, &
292	large_scale_subsidence, microphysics_morrison, &
293	microphysics_seifert, microphysics_sat_adjust, neutral, nudging,&
294	ocean, outflow_l, outflow_s, passive_scalar, plant_canopy, &
295	prho_reference, prho_reference, &
296	prho_reference, pt_reference, pt_reference, pt_reference, &
297	scalar_advec, scalar_advec, simulated_time, sloping_surface, &
298	timestep_scheme, tsc, use_subsidence_tendencies, &
299	use_upstream_for_tke, wind_turbine, ws_scheme_mom, &
300	ws_scheme_sca
301
302	USE cpulog, &
303	ONLY: cpu_log, log_point, log_point_s
304
305
306	USE eqn_state_seawater_mod, &
307	ONLY: eqn_state_seawater
308
309	USE indices, &
310	ONLY: nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv, &
311	nzb, nzt, wall_flags_0
312
313	USE advec_ws, &
314	ONLY: advec_s_ws, advec_u_ws, advec_v_ws, advec_w_ws
315
316	USE advec_s_bc_mod, &
317	ONLY: advec_s_bc
318
319	USE advec_s_pw_mod, &
320	ONLY: advec_s_pw
321
322	USE advec_s_up_mod, &
323	ONLY: advec_s_up
324
325	USE advec_u_pw_mod, &
326	ONLY: advec_u_pw
327
328	USE advec_u_up_mod, &
329	ONLY: advec_u_up
330
331	USE advec_v_pw_mod, &
332	ONLY: advec_v_pw
333
334	USE advec_v_up_mod, &
335	ONLY: advec_v_up
336
337	USE advec_w_pw_mod, &
338	ONLY: advec_w_pw
339
340	USE advec_w_up_mod, &
341	ONLY: advec_w_up
342
343	USE buoyancy_mod, &
344	ONLY: buoyancy
345
346	USE calc_radiation_mod, &
347	ONLY: calc_radiation
348
349	USE coriolis_mod, &
350	ONLY: coriolis
351
352	USE diffusion_s_mod, &
353	ONLY: diffusion_s
354
355	USE diffusion_u_mod, &
356	ONLY: diffusion_u
357
358	USE diffusion_v_mod, &
359	ONLY: diffusion_v
360
361	USE diffusion_w_mod, &
362	ONLY: diffusion_w
363
364	USE kinds
365
366	USE lsf_nudging_mod, &
367	ONLY: ls_advec, nudge
368
369	USE microphysics_mod, &
370	ONLY: microphysics_control
371
372	USE plant_canopy_model_mod, &
373	ONLY: cthf, pcm_tendency
374
375	USE radiation_model_mod, &
376	ONLY: radiation, radiation_tendency, &
377	skip_time_do_radiation
378
379	USE statistics, &
380	ONLY: hom
381
382	USE subsidence_mod, &
383	ONLY: subsidence
384
385	USE turbulence_closure_mod, &
386	ONLY: tcm_prognostic
387
388	USE user_actions_mod, &
389	ONLY: user_actions
390
391	USE surface_mod, &
392	ONLY : surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, &
393	surf_usm_v
394
395	USE wind_turbine_model_mod, &
396	ONLY: wtm_tendencies
397
398
399	PRIVATE
400	PUBLIC prognostic_equations_cache, prognostic_equations_vector
401
402	INTERFACE prognostic_equations_cache
403	MODULE PROCEDURE prognostic_equations_cache
404	END INTERFACE prognostic_equations_cache
405
406	INTERFACE prognostic_equations_vector
407	MODULE PROCEDURE prognostic_equations_vector
408	END INTERFACE prognostic_equations_vector
409
410
411	CONTAINS
412
413
414	!------------------------------------------------------------------------------!
415	! Description:
416	! ------------
417	!> Version with one optimized loop over all equations. It is only allowed to
418	!> be called for the Wicker and Skamarock or Piascek-Williams advection scheme.
419	!>
420	!> Here the calls of most subroutines are embedded in two DO loops over i and j,
421	!> so communication between CPUs is not allowed (does not make sense) within
422	!> these loops.
423	!>
424	!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
425	!------------------------------------------------------------------------------!
426
427	SUBROUTINE prognostic_equations_cache
428
429
430	IMPLICIT NONE
431
432	INTEGER(iwp) :: i !<
433	INTEGER(iwp) :: i_omp_start !<
434	INTEGER(iwp) :: j !<
435	INTEGER(iwp) :: k !<
436	INTEGER(iwp) :: omp_get_thread_num !<
437	INTEGER(iwp) :: tn = 0 !<
438
439	LOGICAL :: loop_start !<
440	INTEGER :: n, lsp !< lsp running index for chem spcs
441
442
443	!
444	!-- Time measurement can only be performed for the whole set of equations
445	CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
446
447	!
448	!-- Calculation of chemical reactions. This is done outside of main loop,
449	!-- since exchange of ghost points is required after this update of the
450	!-- concentrations of chemical species
451	IF ( air_chemistry ) THEN
452	!
453	!-- If required, calculate photolysis frequencies -
454	!-- UNFINISHED: Why not before the intermediate timestep loop?
455	IF ( intermediate_timestep_count == 1 ) THEN
456	CALL photolysis_control
457	ENDIF
458	!
459	!-- Chemical reactions
460	CALL cpu_log( log_point(82), '(chem react + exch_h)', 'start' )
461
462	IF ( chem_gasphase_on ) THEN
463	DO i = nxl, nxr
464	DO j = nys, nyn
465
466	IF ( intermediate_timestep_count == 1 .OR. &
467	call_chem_at_all_substeps ) THEN
468	CALL chem_integrate (i,j)
469	ENDIF
470	ENDDO
471	ENDDO
472	ENDIF
473	!
474	!-- Loop over chemical species
475	CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'start' )
476	DO n = 1, nspec
477	CALL exchange_horiz( chem_species(n)%conc, nbgp )
478	ENDDO
479	CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'stop' )
480
481	CALL cpu_log( log_point(82), '(chem react + exch_h)', 'stop' )
482
483	ENDIF
484
485	!
486	!-- If required, calculate cloud microphysics
487	IF ( cloud_physics .AND. .NOT. microphysics_sat_adjust .AND. &
488	( intermediate_timestep_count == 1 .OR. &
489	call_microphysics_at_all_substeps ) ) &
490	THEN
491	!$OMP PARALLEL PRIVATE (i,j)
492	!$OMP DO
493	DO i = nxlg, nxrg
494	DO j = nysg, nyng
495	CALL microphysics_control( i, j )
496	ENDDO
497	ENDDO
498	!$OMP END PARALLEL
499	ENDIF
500
501	!
502	!-- Loop over all prognostic equations
503	!$OMP PARALLEL PRIVATE (i,i_omp_start,j,k,loop_start,tn)
504
505	!$ tn = omp_get_thread_num()
506	loop_start = .TRUE.
507
508	!$OMP DO
509	DO i = nxl, nxr
510
511	!
512	!-- Store the first loop index. It differs for each thread and is required
513	!-- later in advec_ws
514	IF ( loop_start ) THEN
515	loop_start = .FALSE.
516	i_omp_start = i
517	ENDIF
518
519	DO j = nys, nyn
520	!
521	!-- Tendency terms for u-velocity component
522	IF ( .NOT. outflow_l .OR. i > nxl ) THEN
523
524	tend(:,j,i) = 0.0_wp
525	IF ( timestep_scheme(1:5) == 'runge' ) THEN
526	IF ( ws_scheme_mom ) THEN
527	CALL advec_u_ws( i, j, i_omp_start, tn )
528	ELSE
529	CALL advec_u_pw( i, j )
530	ENDIF
531	ELSE
532	CALL advec_u_up( i, j )
533	ENDIF
534	CALL diffusion_u( i, j )
535	CALL coriolis( i, j, 1 )
536	IF ( sloping_surface .AND. .NOT. neutral ) THEN
537	CALL buoyancy( i, j, pt, 1 )
538	ENDIF
539
540	!
541	!-- Drag by plant canopy
542	IF ( plant_canopy ) CALL pcm_tendency( i, j, 1 )
543
544	!
545	!-- External pressure gradient
546	IF ( dp_external ) THEN
547	DO k = dp_level_ind_b+1, nzt
548	tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
549	ENDDO
550	ENDIF
551
552	!
553	!-- Nudging
554	IF ( nudging ) CALL nudge( i, j, simulated_time, 'u' )
555
556	!
557	!-- Forces by wind turbines
558	IF ( wind_turbine ) CALL wtm_tendencies( i, j, 1 )
559
560	CALL user_actions( i, j, 'u-tendency' )
561	!
562	!-- Prognostic equation for u-velocity component
563	DO k = nzb+1, nzt
564
565	u_p(k,j,i) = u(k,j,i) + ( dt_3d * &
566	( tsc(2) * tend(k,j,i) + &
567	tsc(3) * tu_m(k,j,i) ) &
568	- tsc(5) * rdf(k) &
569	* ( u(k,j,i) - u_init(k) ) &
570	) * MERGE( 1.0_wp, 0.0_wp, &
571	BTEST( wall_flags_0(k,j,i), 1 )&
572	)
573	ENDDO
574
575	!
576	!-- Calculate tendencies for the next Runge-Kutta step
577	IF ( timestep_scheme(1:5) == 'runge' ) THEN
578	IF ( intermediate_timestep_count == 1 ) THEN
579	DO k = nzb+1, nzt
580	tu_m(k,j,i) = tend(k,j,i)
581	ENDDO
582	ELSEIF ( intermediate_timestep_count < &
583	intermediate_timestep_count_max ) THEN
584	DO k = nzb+1, nzt
585	tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
586	+ 5.3125_wp * tu_m(k,j,i)
587	ENDDO
588	ENDIF
589	ENDIF
590
591	ENDIF
592
593	!
594	!-- Tendency terms for v-velocity component
595	IF ( .NOT. outflow_s .OR. j > nys ) THEN
596
597	tend(:,j,i) = 0.0_wp
598	IF ( timestep_scheme(1:5) == 'runge' ) THEN
599	IF ( ws_scheme_mom ) THEN
600	CALL advec_v_ws( i, j, i_omp_start, tn )
601	ELSE
602	CALL advec_v_pw( i, j )
603	ENDIF
604	ELSE
605	CALL advec_v_up( i, j )
606	ENDIF
607	CALL diffusion_v( i, j )
608	CALL coriolis( i, j, 2 )
609
610	!
611	!-- Drag by plant canopy
612	IF ( plant_canopy ) CALL pcm_tendency( i, j, 2 )
613
614	!
615	!-- External pressure gradient
616	IF ( dp_external ) THEN
617	DO k = dp_level_ind_b+1, nzt
618	tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
619	ENDDO
620	ENDIF
621
622	!
623	!-- Nudging
624	IF ( nudging ) CALL nudge( i, j, simulated_time, 'v' )
625
626	!
627	!-- Forces by wind turbines
628	IF ( wind_turbine ) CALL wtm_tendencies( i, j, 2 )
629
630	CALL user_actions( i, j, 'v-tendency' )
631	!
632	!-- Prognostic equation for v-velocity component
633	DO k = nzb+1, nzt
634	v_p(k,j,i) = v(k,j,i) + ( dt_3d * &
635	( tsc(2) * tend(k,j,i) + &
636	tsc(3) * tv_m(k,j,i) ) &
637	- tsc(5) * rdf(k) &
638	* ( v(k,j,i) - v_init(k) )&
639	) * MERGE( 1.0_wp, 0.0_wp, &
640	BTEST( wall_flags_0(k,j,i), 2 )&
641	)
642	ENDDO
643
644	!
645	!-- Calculate tendencies for the next Runge-Kutta step
646	IF ( timestep_scheme(1:5) == 'runge' ) THEN
647	IF ( intermediate_timestep_count == 1 ) THEN
648	DO k = nzb+1, nzt
649	tv_m(k,j,i) = tend(k,j,i)
650	ENDDO
651	ELSEIF ( intermediate_timestep_count < &
652	intermediate_timestep_count_max ) THEN
653	DO k = nzb+1, nzt
654	tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
655	+ 5.3125_wp * tv_m(k,j,i)
656	ENDDO
657	ENDIF
658	ENDIF
659
660	ENDIF
661
662	!
663	!-- Tendency terms for w-velocity component
664	tend(:,j,i) = 0.0_wp
665	IF ( timestep_scheme(1:5) == 'runge' ) THEN
666	IF ( ws_scheme_mom ) THEN
667	CALL advec_w_ws( i, j, i_omp_start, tn )
668	ELSE
669	CALL advec_w_pw( i, j )
670	END IF
671	ELSE
672	CALL advec_w_up( i, j )
673	ENDIF
674	CALL diffusion_w( i, j )
675	CALL coriolis( i, j, 3 )
676
677	IF ( .NOT. neutral ) THEN
678	IF ( ocean ) THEN
679	CALL buoyancy( i, j, rho_ocean, 3 )
680	ELSE
681	IF ( .NOT. humidity ) THEN
682	CALL buoyancy( i, j, pt, 3 )
683	ELSE
684	CALL buoyancy( i, j, vpt, 3 )
685	ENDIF
686	ENDIF
687	ENDIF
688
689	!
690	!-- Drag by plant canopy
691	IF ( plant_canopy ) CALL pcm_tendency( i, j, 3 )
692
693	!
694	!-- Forces by wind turbines
695	IF ( wind_turbine ) CALL wtm_tendencies( i, j, 3 )
696
697	CALL user_actions( i, j, 'w-tendency' )
698	!
699	!-- Prognostic equation for w-velocity component
700	DO k = nzb+1, nzt-1
701	w_p(k,j,i) = w(k,j,i) + ( dt_3d * &
702	( tsc(2) * tend(k,j,i) + &
703	tsc(3) * tw_m(k,j,i) ) &
704	- tsc(5) * rdf(k) * w(k,j,i) &
705	) * MERGE( 1.0_wp, 0.0_wp, &
706	BTEST( wall_flags_0(k,j,i), 3 )&
707	)
708	ENDDO
709
710	!
711	!-- Calculate tendencies for the next Runge-Kutta step
712	IF ( timestep_scheme(1:5) == 'runge' ) THEN
713	IF ( intermediate_timestep_count == 1 ) THEN
714	DO k = nzb+1, nzt-1
715	tw_m(k,j,i) = tend(k,j,i)
716	ENDDO
717	ELSEIF ( intermediate_timestep_count < &
718	intermediate_timestep_count_max ) THEN
719	DO k = nzb+1, nzt-1
720	tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
721	+ 5.3125_wp * tw_m(k,j,i)
722	ENDDO
723	ENDIF
724	ENDIF
725
726	!
727	!-- If required, compute prognostic equation for potential temperature
728	IF ( .NOT. neutral ) THEN
729	!
730	!-- Tendency terms for potential temperature
731	tend(:,j,i) = 0.0_wp
732	IF ( timestep_scheme(1:5) == 'runge' ) THEN
733	IF ( ws_scheme_sca ) THEN
734	CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, diss_s_pt, &
735	flux_l_pt, diss_l_pt, i_omp_start, tn )
736	ELSE
737	CALL advec_s_pw( i, j, pt )
738	ENDIF
739	ELSE
740	CALL advec_s_up( i, j, pt )
741	ENDIF
742	CALL diffusion_s( i, j, pt, &
743	surf_def_h(0)%shf, surf_def_h(1)%shf, &
744	surf_def_h(2)%shf, &
745	surf_lsm_h%shf, surf_usm_h%shf, &
746	surf_def_v(0)%shf, surf_def_v(1)%shf, &
747	surf_def_v(2)%shf, surf_def_v(3)%shf, &
748	surf_lsm_v(0)%shf, surf_lsm_v(1)%shf, &
749	surf_lsm_v(2)%shf, surf_lsm_v(3)%shf, &
750	surf_usm_v(0)%shf, surf_usm_v(1)%shf, &
751	surf_usm_v(2)%shf, surf_usm_v(3)%shf )
752	!
753	!-- If required compute heating/cooling due to long wave radiation
754	!-- processes
755	IF ( cloud_top_radiation ) THEN
756	CALL calc_radiation( i, j )
757	ENDIF
758
759	!
760	!-- Consideration of heat sources within the plant canopy
761	IF ( plant_canopy .AND. cthf /= 0.0_wp ) THEN
762	CALL pcm_tendency( i, j, 4 )
763	ENDIF
764
765	!
766	!-- Large scale advection
767	IF ( large_scale_forcing ) THEN
768	CALL ls_advec( i, j, simulated_time, 'pt' )
769	ENDIF
770
771	!
772	!-- Nudging
773	IF ( nudging ) CALL nudge( i, j, simulated_time, 'pt' )
774
775	!
776	!-- If required, compute effect of large-scale subsidence/ascent
777	IF ( large_scale_subsidence .AND. &
778	.NOT. use_subsidence_tendencies ) THEN
779	CALL subsidence( i, j, tend, pt, pt_init, 2 )
780	ENDIF
781
782	!
783	!-- If required, add tendency due to radiative heating/cooling
784	IF ( radiation .AND. &
785	simulated_time > skip_time_do_radiation ) THEN
786	CALL radiation_tendency ( i, j, tend )
787	ENDIF
788
789
790	CALL user_actions( i, j, 'pt-tendency' )
791	!
792	!-- Prognostic equation for potential temperature
793	DO k = nzb+1, nzt
794	pt_p(k,j,i) = pt(k,j,i) + ( dt_3d * &
795	( tsc(2) * tend(k,j,i) + &
796	tsc(3) * tpt_m(k,j,i) ) &
797	- tsc(5) &
798	* ( pt(k,j,i) - pt_init(k) ) &
799	* ( rdf_sc(k) + ptdf_x(i) &
800	+ ptdf_y(j) ) &
801	) &
802	* MERGE( 1.0_wp, 0.0_wp, &
803	BTEST( wall_flags_0(k,j,i), 0 )&
804	)
805	ENDDO
806
807	!
808	!-- Calculate tendencies for the next Runge-Kutta step
809	IF ( timestep_scheme(1:5) == 'runge' ) THEN
810	IF ( intermediate_timestep_count == 1 ) THEN
811	DO k = nzb+1, nzt
812	tpt_m(k,j,i) = tend(k,j,i)
813	ENDDO
814	ELSEIF ( intermediate_timestep_count < &
815	intermediate_timestep_count_max ) THEN
816	DO k = nzb+1, nzt
817	tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
818	5.3125_wp * tpt_m(k,j,i)
819	ENDDO
820	ENDIF
821	ENDIF
822
823	ENDIF
824
825	!
826	!-- If required, compute prognostic equation for salinity
827	IF ( ocean ) THEN
828
829	!
830	!-- Tendency-terms for salinity
831	tend(:,j,i) = 0.0_wp
832	IF ( timestep_scheme(1:5) == 'runge' ) &
833	THEN
834	IF ( ws_scheme_sca ) THEN
835	CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa, &
836	diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn )
837	ELSE
838	CALL advec_s_pw( i, j, sa )
839	ENDIF
840	ELSE
841	CALL advec_s_up( i, j, sa )
842	ENDIF
843	CALL diffusion_s( i, j, sa, &
844	surf_def_h(0)%sasws, surf_def_h(1)%sasws, &
845	surf_def_h(2)%sasws, &
846	surf_lsm_h%sasws, surf_usm_h%sasws, &
847	surf_def_v(0)%sasws, surf_def_v(1)%sasws, &
848	surf_def_v(2)%sasws, surf_def_v(3)%sasws, &
849	surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws, &
850	surf_lsm_v(2)%sasws, surf_lsm_v(3)%sasws, &
851	surf_usm_v(0)%sasws, surf_usm_v(1)%sasws, &
852	surf_usm_v(2)%sasws, surf_usm_v(3)%sasws )
853
854	CALL user_actions( i, j, 'sa-tendency' )
855
856	!
857	!-- Prognostic equation for salinity
858	DO k = nzb+1, nzt
859	sa_p(k,j,i) = sa(k,j,i) + ( dt_3d * &
860	( tsc(2) * tend(k,j,i) + &
861	tsc(3) * tsa_m(k,j,i) ) &
862	- tsc(5) * rdf_sc(k) &
863	* ( sa(k,j,i) - sa_init(k) )&
864	) * MERGE( 1.0_wp, 0.0_wp, &
865	BTEST( wall_flags_0(k,j,i), 0 )&
866	)
867	IF ( sa_p(k,j,i) < 0.0_wp ) sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
868	ENDDO
869
870	!
871	!-- Calculate tendencies for the next Runge-Kutta step
872	IF ( timestep_scheme(1:5) == 'runge' ) THEN
873	IF ( intermediate_timestep_count == 1 ) THEN
874	DO k = nzb+1, nzt
875	tsa_m(k,j,i) = tend(k,j,i)
876	ENDDO
877	ELSEIF ( intermediate_timestep_count < &
878	intermediate_timestep_count_max ) THEN
879	DO k = nzb+1, nzt
880	tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
881	5.3125_wp * tsa_m(k,j,i)
882	ENDDO
883	ENDIF
884	ENDIF
885
886	!
887	!-- Calculate density by the equation of state for seawater
888	CALL eqn_state_seawater( i, j )
889
890	ENDIF
891
892	!
893	!-- If required, compute prognostic equation for total water content
894	IF ( humidity ) THEN
895
896	!
897	!-- Tendency-terms for total water content / scalar
898	tend(:,j,i) = 0.0_wp
899	IF ( timestep_scheme(1:5) == 'runge' ) &
900	THEN
901	IF ( ws_scheme_sca ) THEN
902	CALL advec_s_ws( i, j, q, 'q', flux_s_q, &
903	diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn )
904	ELSE
905	CALL advec_s_pw( i, j, q )
906	ENDIF
907	ELSE
908	CALL advec_s_up( i, j, q )
909	ENDIF
910	CALL diffusion_s( i, j, q, &
911	surf_def_h(0)%qsws, surf_def_h(1)%qsws, &
912	surf_def_h(2)%qsws, &
913	surf_lsm_h%qsws, surf_usm_h%qsws, &
914	surf_def_v(0)%qsws, surf_def_v(1)%qsws, &
915	surf_def_v(2)%qsws, surf_def_v(3)%qsws, &
916	surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws, &
917	surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws, &
918	surf_usm_v(0)%qsws, surf_usm_v(1)%qsws, &
919	surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
920
921	!
922	!-- Sink or source of humidity due to canopy elements
923	IF ( plant_canopy ) CALL pcm_tendency( i, j, 5 )
924
925	!
926	!-- Large scale advection
927	IF ( large_scale_forcing ) THEN
928	CALL ls_advec( i, j, simulated_time, 'q' )
929	ENDIF
930
931	!
932	!-- Nudging
933	IF ( nudging ) CALL nudge( i, j, simulated_time, 'q' )
934
935	!
936	!-- If required compute influence of large-scale subsidence/ascent
937	IF ( large_scale_subsidence .AND. &
938	.NOT. use_subsidence_tendencies ) THEN
939	CALL subsidence( i, j, tend, q, q_init, 3 )
940	ENDIF
941
942	CALL user_actions( i, j, 'q-tendency' )
943
944	!
945	!-- Prognostic equation for total water content / scalar
946	DO k = nzb+1, nzt
947	q_p(k,j,i) = q(k,j,i) + ( dt_3d * &
948	( tsc(2) * tend(k,j,i) + &
949	tsc(3) * tq_m(k,j,i) ) &
950	- tsc(5) * rdf_sc(k) * &
951	( q(k,j,i) - q_init(k) ) &
952	) &
953	* MERGE( 1.0_wp, 0.0_wp, &
954	BTEST( wall_flags_0(k,j,i), 0 )&
955	)
956	IF ( q_p(k,j,i) < 0.0_wp ) q_p(k,j,i) = 0.1_wp * q(k,j,i)
957	ENDDO
958
959	!
960	!-- Calculate tendencies for the next Runge-Kutta step
961	IF ( timestep_scheme(1:5) == 'runge' ) THEN
962	IF ( intermediate_timestep_count == 1 ) THEN
963	DO k = nzb+1, nzt
964	tq_m(k,j,i) = tend(k,j,i)
965	ENDDO
966	ELSEIF ( intermediate_timestep_count < &
967	intermediate_timestep_count_max ) THEN
968	DO k = nzb+1, nzt
969	tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
970	5.3125_wp * tq_m(k,j,i)
971	ENDDO
972	ENDIF
973	ENDIF
974
975	!
976	!-- If required, calculate prognostic equations for cloud water content
977	!-- and cloud drop concentration
978	IF ( cloud_physics .AND. microphysics_morrison ) THEN
979	!
980	!-- Calculate prognostic equation for cloud water content
981	tend(:,j,i) = 0.0_wp
982	IF ( timestep_scheme(1:5) == 'runge' ) &
983	THEN
984	IF ( ws_scheme_sca ) THEN
985	CALL advec_s_ws( i, j, qc, 'qc', flux_s_qc, &
986	diss_s_qc, flux_l_qc, diss_l_qc, &
987	i_omp_start, tn )
988	ELSE
989	CALL advec_s_pw( i, j, qc )
990	ENDIF
991	ELSE
992	CALL advec_s_up( i, j, qc )
993	ENDIF
994	CALL diffusion_s( i, j, qc, &
995	surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, &
996	surf_def_h(2)%qcsws, &
997	surf_lsm_h%qcsws, surf_usm_h%qcsws, &
998	surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, &
999	surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, &
1000	surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, &
1001	surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, &
1002	surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, &
1003	surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )
1004
1005	!
1006	!-- Prognostic equation for cloud water content
1007	DO k = nzb+1, nzt
1008	qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * &
1009	( tsc(2) * tend(k,j,i) + &
1010	tsc(3) * tqc_m(k,j,i) )&
1011	- tsc(5) * rdf_sc(k) &
1012	* qc(k,j,i) &
1013	) &
1014	* MERGE( 1.0_wp, 0.0_wp, &
1015	BTEST( wall_flags_0(k,j,i), 0 )&
1016	)
1017	IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp
1018	ENDDO
1019	!
1020	!-- Calculate tendencies for the next Runge-Kutta step
1021	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1022	IF ( intermediate_timestep_count == 1 ) THEN
1023	DO k = nzb+1, nzt
1024	tqc_m(k,j,i) = tend(k,j,i)
1025	ENDDO
1026	ELSEIF ( intermediate_timestep_count < &
1027	intermediate_timestep_count_max ) THEN
1028	DO k = nzb+1, nzt
1029	tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1030	5.3125_wp * tqc_m(k,j,i)
1031	ENDDO
1032	ENDIF
1033	ENDIF
1034
1035	!
1036	!-- Calculate prognostic equation for cloud drop concentration.
1037	tend(:,j,i) = 0.0_wp
1038	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1039	IF ( ws_scheme_sca ) THEN
1040	CALL advec_s_ws( i, j, nc, 'nc', flux_s_nc, &
1041	diss_s_nc, flux_l_nc, diss_l_nc, &
1042	i_omp_start, tn )
1043	ELSE
1044	CALL advec_s_pw( i, j, nc )
1045	ENDIF
1046	ELSE
1047	CALL advec_s_up( i, j, nc )
1048	ENDIF
1049	CALL diffusion_s( i, j, nc, &
1050	surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, &
1051	surf_def_h(2)%ncsws, &
1052	surf_lsm_h%ncsws, surf_usm_h%ncsws, &
1053	surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, &
1054	surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, &
1055	surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, &
1056	surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, &
1057	surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, &
1058	surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )
1059
1060	!
1061	!-- Prognostic equation for cloud drop concentration
1062	DO k = nzb+1, nzt
1063	nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * &
1064	( tsc(2) * tend(k,j,i) + &
1065	tsc(3) * tnc_m(k,j,i) )&
1066	- tsc(5) * rdf_sc(k) &
1067	* nc(k,j,i) &
1068	) &
1069	* MERGE( 1.0_wp, 0.0_wp, &
1070	BTEST( wall_flags_0(k,j,i), 0 )&
1071	)
1072	IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp
1073	ENDDO
1074	!
1075	!-- Calculate tendencies for the next Runge-Kutta step
1076	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1077	IF ( intermediate_timestep_count == 1 ) THEN
1078	DO k = nzb+1, nzt
1079	tnc_m(k,j,i) = tend(k,j,i)
1080	ENDDO
1081	ELSEIF ( intermediate_timestep_count < &
1082	intermediate_timestep_count_max ) THEN
1083	DO k = nzb+1, nzt
1084	tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1085	5.3125_wp * tnc_m(k,j,i)
1086	ENDDO
1087	ENDIF
1088	ENDIF
1089
1090	ENDIF
1091	!
1092	!-- If required, calculate prognostic equations for rain water content
1093	!-- and rain drop concentration
1094	IF ( cloud_physics .AND. microphysics_seifert ) THEN
1095	!
1096	!-- Calculate prognostic equation for rain water content
1097	tend(:,j,i) = 0.0_wp
1098	IF ( timestep_scheme(1:5) == 'runge' ) &
1099	THEN
1100	IF ( ws_scheme_sca ) THEN
1101	CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr, &
1102	diss_s_qr, flux_l_qr, diss_l_qr, &
1103	i_omp_start, tn )
1104	ELSE
1105	CALL advec_s_pw( i, j, qr )
1106	ENDIF
1107	ELSE
1108	CALL advec_s_up( i, j, qr )
1109	ENDIF
1110	CALL diffusion_s( i, j, qr, &
1111	surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, &
1112	surf_def_h(2)%qrsws, &
1113	surf_lsm_h%qrsws, surf_usm_h%qrsws, &
1114	surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, &
1115	surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, &
1116	surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, &
1117	surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, &
1118	surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, &
1119	surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )
1120
1121	!
1122	!-- Prognostic equation for rain water content
1123	DO k = nzb+1, nzt
1124	qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * &
1125	( tsc(2) * tend(k,j,i) + &
1126	tsc(3) * tqr_m(k,j,i) )&
1127	- tsc(5) * rdf_sc(k) &
1128	* qr(k,j,i) &
1129	) &
1130	* MERGE( 1.0_wp, 0.0_wp, &
1131	BTEST( wall_flags_0(k,j,i), 0 )&
1132	)
1133	IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp
1134	ENDDO
1135	!
1136	!-- Calculate tendencies for the next Runge-Kutta step
1137	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1138	IF ( intermediate_timestep_count == 1 ) THEN
1139	DO k = nzb+1, nzt
1140	tqr_m(k,j,i) = tend(k,j,i)
1141	ENDDO
1142	ELSEIF ( intermediate_timestep_count < &
1143	intermediate_timestep_count_max ) THEN
1144	DO k = nzb+1, nzt
1145	tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1146	5.3125_wp * tqr_m(k,j,i)
1147	ENDDO
1148	ENDIF
1149	ENDIF
1150
1151	!
1152	!-- Calculate prognostic equation for rain drop concentration.
1153	tend(:,j,i) = 0.0_wp
1154	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1155	IF ( ws_scheme_sca ) THEN
1156	CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr, &
1157	diss_s_nr, flux_l_nr, diss_l_nr, &
1158	i_omp_start, tn )
1159	ELSE
1160	CALL advec_s_pw( i, j, nr )
1161	ENDIF
1162	ELSE
1163	CALL advec_s_up( i, j, nr )
1164	ENDIF
1165	CALL diffusion_s( i, j, nr, &
1166	surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, &
1167	surf_def_h(2)%nrsws, &
1168	surf_lsm_h%nrsws, surf_usm_h%nrsws, &
1169	surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, &
1170	surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, &
1171	surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, &
1172	surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, &
1173	surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, &
1174	surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )
1175
1176	!
1177	!-- Prognostic equation for rain drop concentration
1178	DO k = nzb+1, nzt
1179	nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * &
1180	( tsc(2) * tend(k,j,i) + &
1181	tsc(3) * tnr_m(k,j,i) )&
1182	- tsc(5) * rdf_sc(k) &
1183	* nr(k,j,i) &
1184	) &
1185	* MERGE( 1.0_wp, 0.0_wp, &
1186	BTEST( wall_flags_0(k,j,i), 0 )&
1187	)
1188	IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp
1189	ENDDO
1190	!
1191	!-- Calculate tendencies for the next Runge-Kutta step
1192	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1193	IF ( intermediate_timestep_count == 1 ) THEN
1194	DO k = nzb+1, nzt
1195	tnr_m(k,j,i) = tend(k,j,i)
1196	ENDDO
1197	ELSEIF ( intermediate_timestep_count < &
1198	intermediate_timestep_count_max ) THEN
1199	DO k = nzb+1, nzt
1200	tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1201	5.3125_wp * tnr_m(k,j,i)
1202	ENDDO
1203	ENDIF
1204	ENDIF
1205
1206	ENDIF
1207
1208	ENDIF
1209
1210	!
1211	!-- If required, compute prognostic equation for scalar
1212	IF ( passive_scalar ) THEN
1213	!
1214	!-- Tendency-terms for total water content / scalar
1215	tend(:,j,i) = 0.0_wp
1216	IF ( timestep_scheme(1:5) == 'runge' ) &
1217	THEN
1218	IF ( ws_scheme_sca ) THEN
1219	CALL advec_s_ws( i, j, s, 's', flux_s_s, &
1220	diss_s_s, flux_l_s, diss_l_s, i_omp_start, tn )
1221	ELSE
1222	CALL advec_s_pw( i, j, s )
1223	ENDIF
1224	ELSE
1225	CALL advec_s_up( i, j, s )
1226	ENDIF
1227	CALL diffusion_s( i, j, s, &
1228	surf_def_h(0)%ssws, surf_def_h(1)%ssws, &
1229	surf_def_h(2)%ssws, &
1230	surf_lsm_h%ssws, surf_usm_h%ssws, &
1231	surf_def_v(0)%ssws, surf_def_v(1)%ssws, &
1232	surf_def_v(2)%ssws, surf_def_v(3)%ssws, &
1233	surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws, &
1234	surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws, &
1235	surf_usm_v(0)%ssws, surf_usm_v(1)%ssws, &
1236	surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
1237
1238	!
1239	!-- Sink or source of scalar concentration due to canopy elements
1240	IF ( plant_canopy ) CALL pcm_tendency( i, j, 7 )
1241
1242	!
1243	!-- Large scale advection, still need to be extended for scalars
1244	! IF ( large_scale_forcing ) THEN
1245	! CALL ls_advec( i, j, simulated_time, 's' )
1246	! ENDIF
1247
1248	!
1249	!-- Nudging, still need to be extended for scalars
1250	! IF ( nudging ) CALL nudge( i, j, simulated_time, 's' )
1251
1252	!
1253	!-- If required compute influence of large-scale subsidence/ascent.
1254	!-- Note, the last argument is of no meaning in this case, as it is
1255	!-- only used in conjunction with large_scale_forcing, which is to
1256	!-- date not implemented for scalars.
1257	IF ( large_scale_subsidence .AND. &
1258	.NOT. use_subsidence_tendencies .AND. &
1259	.NOT. large_scale_forcing ) THEN
1260	CALL subsidence( i, j, tend, s, s_init, 3 )
1261	ENDIF
1262
1263	CALL user_actions( i, j, 's-tendency' )
1264
1265	!
1266	!-- Prognostic equation for scalar
1267	DO k = nzb+1, nzt
1268	s_p(k,j,i) = s(k,j,i) + ( dt_3d * &
1269	( tsc(2) * tend(k,j,i) + &
1270	tsc(3) * ts_m(k,j,i) ) &
1271	- tsc(5) * rdf_sc(k) &
1272	* ( s(k,j,i) - s_init(k) )&
1273	) &
1274	* MERGE( 1.0_wp, 0.0_wp, &
1275	BTEST( wall_flags_0(k,j,i), 0 )&
1276	)
1277	IF ( s_p(k,j,i) < 0.0_wp ) s_p(k,j,i) = 0.1_wp * s(k,j,i)
1278	ENDDO
1279
1280	!
1281	!-- Calculate tendencies for the next Runge-Kutta step
1282	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1283	IF ( intermediate_timestep_count == 1 ) THEN
1284	DO k = nzb+1, nzt
1285	ts_m(k,j,i) = tend(k,j,i)
1286	ENDDO
1287	ELSEIF ( intermediate_timestep_count < &
1288	intermediate_timestep_count_max ) THEN
1289	DO k = nzb+1, nzt
1290	ts_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1291	5.3125_wp * ts_m(k,j,i)
1292	ENDDO
1293	ENDIF
1294	ENDIF
1295
1296	ENDIF
1297	!
1298	!-- Calculate prognostic equations for turbulence closure
1299	CALL tcm_prognostic( i, j, i_omp_start, tn )
1300
1301	!
1302	!-- If required, compute prognostic equation for chemical quantites
1303	IF ( air_chemistry ) THEN
1304	CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'start' )
1305	!
1306	!-- Loop over chemical species
1307	DO lsp = 1, nvar
1308	CALL chem_prognostic_equations ( chem_species(lsp)%conc_p, &
1309	chem_species(lsp)%conc, &
1310	chem_species(lsp)%tconc_m, &
1311	chem_species(lsp)%conc_pr_init, &
1312	i, j, i_omp_start, tn, lsp, &
1313	chem_species(lsp)%flux_s_cs, &
1314	chem_species(lsp)%diss_s_cs, &
1315	chem_species(lsp)%flux_l_cs, &
1316	chem_species(lsp)%diss_l_cs )
1317	ENDDO
1318
1319	CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'stop' )
1320	ENDIF ! Chemicals equations
1321
1322	ENDDO
1323	ENDDO
1324	!$OMP END PARALLEL
1325
1326
1327
1328
1329	CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
1330
1331
1332	END SUBROUTINE prognostic_equations_cache
1333
1334
1335	!------------------------------------------------------------------------------!
1336	! Description:
1337	! ------------
1338	!> Version for vector machines
1339	!------------------------------------------------------------------------------!
1340
1341	SUBROUTINE prognostic_equations_vector
1342
1343
1344	IMPLICIT NONE
1345
1346	INTEGER(iwp) :: i !<
1347	INTEGER(iwp) :: j !<
1348	INTEGER(iwp) :: k !<
1349	INTEGER(iwp) :: lsp !< running index for chemical species
1350
1351	REAL(wp) :: sbt !<
1352
1353
1354	!
1355	!-- If required, calculate cloud microphysical impacts
1356	IF ( cloud_physics .AND. .NOT. microphysics_sat_adjust .AND. &
1357	( intermediate_timestep_count == 1 .OR. &
1358	call_microphysics_at_all_substeps ) &
1359	) THEN
1360	CALL cpu_log( log_point(51), 'microphysics', 'start' )
1361	CALL microphysics_control
1362	CALL cpu_log( log_point(51), 'microphysics', 'stop' )
1363	ENDIF
1364
1365	!
1366	!-- u-velocity component
1367	CALL cpu_log( log_point(5), 'u-equation', 'start' )
1368
1369	tend = 0.0_wp
1370	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1371	IF ( ws_scheme_mom ) THEN
1372	CALL advec_u_ws
1373	ELSE
1374	CALL advec_u_pw
1375	ENDIF
1376	ELSE
1377	CALL advec_u_up
1378	ENDIF
1379	CALL diffusion_u
1380	CALL coriolis( 1 )
1381	IF ( sloping_surface .AND. .NOT. neutral ) THEN
1382	CALL buoyancy( pt, 1 )
1383	ENDIF
1384
1385	!
1386	!-- Drag by plant canopy
1387	IF ( plant_canopy ) CALL pcm_tendency( 1 )
1388
1389	!
1390	!-- External pressure gradient
1391	IF ( dp_external ) THEN
1392	DO i = nxlu, nxr
1393	DO j = nys, nyn
1394	DO k = dp_level_ind_b+1, nzt
1395	tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
1396	ENDDO
1397	ENDDO
1398	ENDDO
1399	ENDIF
1400
1401	!
1402	!-- Nudging
1403	IF ( nudging ) CALL nudge( simulated_time, 'u' )
1404
1405	!
1406	!-- Forces by wind turbines
1407	IF ( wind_turbine ) CALL wtm_tendencies( 1 )
1408
1409	CALL user_actions( 'u-tendency' )
1410
1411	!
1412	!-- Prognostic equation for u-velocity component
1413	DO i = nxlu, nxr
1414	DO j = nys, nyn
1415	DO k = nzb+1, nzt
1416	u_p(k,j,i) = u(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
1417	tsc(3) * tu_m(k,j,i) ) &
1418	- tsc(5) * rdf(k) * &
1419	( u(k,j,i) - u_init(k) ) &
1420	) * MERGE( 1.0_wp, 0.0_wp, &
1421	BTEST( wall_flags_0(k,j,i), 1 ) &
1422	)
1423	ENDDO
1424	ENDDO
1425	ENDDO
1426
1427	!
1428	!-- Calculate tendencies for the next Runge-Kutta step
1429	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1430	IF ( intermediate_timestep_count == 1 ) THEN
1431	DO i = nxlu, nxr
1432	DO j = nys, nyn
1433	DO k = nzb+1, nzt
1434	tu_m(k,j,i) = tend(k,j,i)
1435	ENDDO
1436	ENDDO
1437	ENDDO
1438	ELSEIF ( intermediate_timestep_count < &
1439	intermediate_timestep_count_max ) THEN
1440	DO i = nxlu, nxr
1441	DO j = nys, nyn
1442	DO k = nzb+1, nzt
1443	tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
1444	+ 5.3125_wp * tu_m(k,j,i)
1445	ENDDO
1446	ENDDO
1447	ENDDO
1448	ENDIF
1449	ENDIF
1450
1451	CALL cpu_log( log_point(5), 'u-equation', 'stop' )
1452
1453	!
1454	!-- v-velocity component
1455	CALL cpu_log( log_point(6), 'v-equation', 'start' )
1456
1457	tend = 0.0_wp
1458	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1459	IF ( ws_scheme_mom ) THEN
1460	CALL advec_v_ws
1461	ELSE
1462	CALL advec_v_pw
1463	END IF
1464	ELSE
1465	CALL advec_v_up
1466	ENDIF
1467	CALL diffusion_v
1468	CALL coriolis( 2 )
1469
1470	!
1471	!-- Drag by plant canopy
1472	IF ( plant_canopy ) CALL pcm_tendency( 2 )
1473
1474	!
1475	!-- External pressure gradient
1476	IF ( dp_external ) THEN
1477	DO i = nxl, nxr
1478	DO j = nysv, nyn
1479	DO k = dp_level_ind_b+1, nzt
1480	tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
1481	ENDDO
1482	ENDDO
1483	ENDDO
1484	ENDIF
1485
1486	!
1487	!-- Nudging
1488	IF ( nudging ) CALL nudge( simulated_time, 'v' )
1489
1490	!
1491	!-- Forces by wind turbines
1492	IF ( wind_turbine ) CALL wtm_tendencies( 2 )
1493
1494	CALL user_actions( 'v-tendency' )
1495
1496	!
1497	!-- Prognostic equation for v-velocity component
1498	DO i = nxl, nxr
1499	DO j = nysv, nyn
1500	DO k = nzb+1, nzt
1501	v_p(k,j,i) = v(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
1502	tsc(3) * tv_m(k,j,i) ) &
1503	- tsc(5) * rdf(k) * &
1504	( v(k,j,i) - v_init(k) ) &
1505	) * MERGE( 1.0_wp, 0.0_wp, &
1506	BTEST( wall_flags_0(k,j,i), 2 )&
1507	)
1508	ENDDO
1509	ENDDO
1510	ENDDO
1511
1512	!
1513	!-- Calculate tendencies for the next Runge-Kutta step
1514	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1515	IF ( intermediate_timestep_count == 1 ) THEN
1516	DO i = nxl, nxr
1517	DO j = nysv, nyn
1518	DO k = nzb+1, nzt
1519	tv_m(k,j,i) = tend(k,j,i)
1520	ENDDO
1521	ENDDO
1522	ENDDO
1523	ELSEIF ( intermediate_timestep_count < &
1524	intermediate_timestep_count_max ) THEN
1525	DO i = nxl, nxr
1526	DO j = nysv, nyn
1527	DO k = nzb+1, nzt
1528	tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
1529	+ 5.3125_wp * tv_m(k,j,i)
1530	ENDDO
1531	ENDDO
1532	ENDDO
1533	ENDIF
1534	ENDIF
1535
1536	CALL cpu_log( log_point(6), 'v-equation', 'stop' )
1537
1538	!
1539	!-- w-velocity component
1540	CALL cpu_log( log_point(7), 'w-equation', 'start' )
1541
1542	tend = 0.0_wp
1543	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1544	IF ( ws_scheme_mom ) THEN
1545	CALL advec_w_ws
1546	ELSE
1547	CALL advec_w_pw
1548	ENDIF
1549	ELSE
1550	CALL advec_w_up
1551	ENDIF
1552	CALL diffusion_w
1553	CALL coriolis( 3 )
1554
1555	IF ( .NOT. neutral ) THEN
1556	IF ( ocean ) THEN
1557	CALL buoyancy( rho_ocean, 3 )
1558	ELSE
1559	IF ( .NOT. humidity ) THEN
1560	CALL buoyancy( pt, 3 )
1561	ELSE
1562	CALL buoyancy( vpt, 3 )
1563	ENDIF
1564	ENDIF
1565	ENDIF
1566
1567	!
1568	!-- Drag by plant canopy
1569	IF ( plant_canopy ) CALL pcm_tendency( 3 )
1570
1571	!
1572	!-- Forces by wind turbines
1573	IF ( wind_turbine ) CALL wtm_tendencies( 3 )
1574
1575	CALL user_actions( 'w-tendency' )
1576
1577	!
1578	!-- Prognostic equation for w-velocity component
1579	DO i = nxl, nxr
1580	DO j = nys, nyn
1581	DO k = nzb+1, nzt-1
1582	w_p(k,j,i) = w(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + &
1583	tsc(3) * tw_m(k,j,i) ) &
1584	- tsc(5) * rdf(k) * w(k,j,i) &
1585	) * MERGE( 1.0_wp, 0.0_wp, &
1586	BTEST( wall_flags_0(k,j,i), 3 )&
1587	)
1588	ENDDO
1589	ENDDO
1590	ENDDO
1591
1592	!
1593	!-- Calculate tendencies for the next Runge-Kutta step
1594	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1595	IF ( intermediate_timestep_count == 1 ) THEN
1596	DO i = nxl, nxr
1597	DO j = nys, nyn
1598	DO k = nzb+1, nzt-1
1599	tw_m(k,j,i) = tend(k,j,i)
1600	ENDDO
1601	ENDDO
1602	ENDDO
1603	ELSEIF ( intermediate_timestep_count < &
1604	intermediate_timestep_count_max ) THEN
1605	DO i = nxl, nxr
1606	DO j = nys, nyn
1607	DO k = nzb+1, nzt-1
1608	tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
1609	+ 5.3125_wp * tw_m(k,j,i)
1610	ENDDO
1611	ENDDO
1612	ENDDO
1613	ENDIF
1614	ENDIF
1615
1616	CALL cpu_log( log_point(7), 'w-equation', 'stop' )
1617
1618
1619	!
1620	!-- If required, compute prognostic equation for potential temperature
1621	IF ( .NOT. neutral ) THEN
1622
1623	CALL cpu_log( log_point(13), 'pt-equation', 'start' )
1624
1625	!
1626	!-- pt-tendency terms with communication
1627	sbt = tsc(2)
1628	IF ( scalar_advec == 'bc-scheme' ) THEN
1629
1630	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
1631	!
1632	!-- Bott-Chlond scheme always uses Euler time step. Thus:
1633	sbt = 1.0_wp
1634	ENDIF
1635	tend = 0.0_wp
1636	CALL advec_s_bc( pt, 'pt' )
1637
1638	ENDIF
1639
1640	!
1641	!-- pt-tendency terms with no communication
1642	IF ( scalar_advec /= 'bc-scheme' ) THEN
1643	tend = 0.0_wp
1644	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1645	IF ( ws_scheme_sca ) THEN
1646	CALL advec_s_ws( pt, 'pt' )
1647	ELSE
1648	CALL advec_s_pw( pt )
1649	ENDIF
1650	ELSE
1651	CALL advec_s_up( pt )
1652	ENDIF
1653	ENDIF
1654
1655	CALL diffusion_s( pt, &
1656	surf_def_h(0)%shf, surf_def_h(1)%shf, &
1657	surf_def_h(2)%shf, &
1658	surf_lsm_h%shf, surf_usm_h%shf, &
1659	surf_def_v(0)%shf, surf_def_v(1)%shf, &
1660	surf_def_v(2)%shf, surf_def_v(3)%shf, &
1661	surf_lsm_v(0)%shf, surf_lsm_v(1)%shf, &
1662	surf_lsm_v(2)%shf, surf_lsm_v(3)%shf, &
1663	surf_usm_v(0)%shf, surf_usm_v(1)%shf, &
1664	surf_usm_v(2)%shf, surf_usm_v(3)%shf )
1665	!
1666	!-- If required compute heating/cooling due to long wave radiation processes
1667	IF ( cloud_top_radiation ) THEN
1668	CALL calc_radiation
1669	ENDIF
1670
1671	!
1672	!-- Consideration of heat sources within the plant canopy
1673	IF ( plant_canopy .AND. ( cthf /= 0.0_wp ) ) THEN
1674	CALL pcm_tendency( 4 )
1675	ENDIF
1676
1677	!
1678	!-- Large scale advection
1679	IF ( large_scale_forcing ) THEN
1680	CALL ls_advec( simulated_time, 'pt' )
1681	ENDIF
1682
1683	!
1684	!-- Nudging
1685	IF ( nudging ) CALL nudge( simulated_time, 'pt' )
1686
1687	!
1688	!-- If required compute influence of large-scale subsidence/ascent
1689	IF ( large_scale_subsidence .AND. &
1690	.NOT. use_subsidence_tendencies ) THEN
1691	CALL subsidence( tend, pt, pt_init, 2 )
1692	ENDIF
1693
1694	!
1695	!-- If required, add tendency due to radiative heating/cooling
1696	IF ( radiation .AND. &
1697	simulated_time > skip_time_do_radiation ) THEN
1698	CALL radiation_tendency ( tend )
1699	ENDIF
1700
1701	CALL user_actions( 'pt-tendency' )
1702
1703	!
1704	!-- Prognostic equation for potential temperature
1705	DO i = nxl, nxr
1706	DO j = nys, nyn
1707	DO k = nzb+1, nzt
1708	pt_p(k,j,i) = pt(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
1709	tsc(3) * tpt_m(k,j,i) ) &
1710	- tsc(5) * &
1711	( pt(k,j,i) - pt_init(k) ) *&
1712	( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )&
1713	) &
1714	* MERGE( 1.0_wp, 0.0_wp, &
1715	BTEST( wall_flags_0(k,j,i), 0 ) &
1716	)
1717	ENDDO
1718	ENDDO
1719	ENDDO
1720
1721	!
1722	!-- Calculate tendencies for the next Runge-Kutta step
1723	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1724	IF ( intermediate_timestep_count == 1 ) THEN
1725	DO i = nxl, nxr
1726	DO j = nys, nyn
1727	DO k = nzb+1, nzt
1728	tpt_m(k,j,i) = tend(k,j,i)
1729	ENDDO
1730	ENDDO
1731	ENDDO
1732	ELSEIF ( intermediate_timestep_count < &
1733	intermediate_timestep_count_max ) THEN
1734	DO i = nxl, nxr
1735	DO j = nys, nyn
1736	DO k = nzb+1, nzt
1737	tpt_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1738	5.3125_wp * tpt_m(k,j,i)
1739	ENDDO
1740	ENDDO
1741	ENDDO
1742	ENDIF
1743	ENDIF
1744
1745	CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
1746
1747	ENDIF
1748
1749	!
1750	!-- If required, compute prognostic equation for salinity
1751	IF ( ocean ) THEN
1752
1753	CALL cpu_log( log_point(37), 'sa-equation', 'start' )
1754
1755	!
1756	!-- sa-tendency terms with communication
1757	sbt = tsc(2)
1758	IF ( scalar_advec == 'bc-scheme' ) THEN
1759
1760	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
1761	!
1762	!-- Bott-Chlond scheme always uses Euler time step. Thus:
1763	sbt = 1.0_wp
1764	ENDIF
1765	tend = 0.0_wp
1766	CALL advec_s_bc( sa, 'sa' )
1767
1768	ENDIF
1769
1770	!
1771	!-- sa-tendency terms with no communication
1772	IF ( scalar_advec /= 'bc-scheme' ) THEN
1773	tend = 0.0_wp
1774	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1775	IF ( ws_scheme_sca ) THEN
1776	CALL advec_s_ws( sa, 'sa' )
1777	ELSE
1778	CALL advec_s_pw( sa )
1779	ENDIF
1780	ELSE
1781	CALL advec_s_up( sa )
1782	ENDIF
1783	ENDIF
1784
1785	CALL diffusion_s( sa, &
1786	surf_def_h(0)%sasws, surf_def_h(1)%sasws, &
1787	surf_def_h(2)%sasws, &
1788	surf_lsm_h%sasws, surf_usm_h%sasws, &
1789	surf_def_v(0)%sasws, surf_def_v(1)%sasws, &
1790	surf_def_v(2)%sasws, surf_def_v(3)%sasws, &
1791	surf_lsm_v(0)%sasws, surf_lsm_v(1)%sasws, &
1792	surf_lsm_v(2)%sasws, surf_lsm_v(3)%sasws, &
1793	surf_usm_v(0)%sasws, surf_usm_v(1)%sasws, &
1794	surf_usm_v(2)%sasws, surf_usm_v(3)%sasws )
1795
1796	CALL user_actions( 'sa-tendency' )
1797
1798	!
1799	!-- Prognostic equation for salinity
1800	DO i = nxl, nxr
1801	DO j = nys, nyn
1802	DO k = nzb+1, nzt
1803	sa_p(k,j,i) = sa(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
1804	tsc(3) * tsa_m(k,j,i) ) &
1805	- tsc(5) * rdf_sc(k) * &
1806	( sa(k,j,i) - sa_init(k) ) &
1807	) &
1808	* MERGE( 1.0_wp, 0.0_wp, &
1809	BTEST( wall_flags_0(k,j,i), 0 ) &
1810	)
1811	IF ( sa_p(k,j,i) < 0.0_wp ) sa_p(k,j,i) = 0.1_wp * sa(k,j,i)
1812	ENDDO
1813	ENDDO
1814	ENDDO
1815
1816	!
1817	!-- Calculate tendencies for the next Runge-Kutta step
1818	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1819	IF ( intermediate_timestep_count == 1 ) THEN
1820	DO i = nxl, nxr
1821	DO j = nys, nyn
1822	DO k = nzb+1, nzt
1823	tsa_m(k,j,i) = tend(k,j,i)
1824	ENDDO
1825	ENDDO
1826	ENDDO
1827	ELSEIF ( intermediate_timestep_count < &
1828	intermediate_timestep_count_max ) THEN
1829	DO i = nxl, nxr
1830	DO j = nys, nyn
1831	DO k = nzb+1, nzt
1832	tsa_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
1833	5.3125_wp * tsa_m(k,j,i)
1834	ENDDO
1835	ENDDO
1836	ENDDO
1837	ENDIF
1838	ENDIF
1839
1840	CALL cpu_log( log_point(37), 'sa-equation', 'stop' )
1841
1842	!
1843	!-- Calculate density by the equation of state for seawater
1844	CALL cpu_log( log_point(38), 'eqns-seawater', 'start' )
1845	CALL eqn_state_seawater
1846	CALL cpu_log( log_point(38), 'eqns-seawater', 'stop' )
1847
1848	ENDIF
1849
1850	!
1851	!-- If required, compute prognostic equation for total water content
1852	IF ( humidity ) THEN
1853
1854	CALL cpu_log( log_point(29), 'q-equation', 'start' )
1855
1856	!
1857	!-- Scalar/q-tendency terms with communication
1858	sbt = tsc(2)
1859	IF ( scalar_advec == 'bc-scheme' ) THEN
1860
1861	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
1862	!
1863	!-- Bott-Chlond scheme always uses Euler time step. Thus:
1864	sbt = 1.0_wp
1865	ENDIF
1866	tend = 0.0_wp
1867	CALL advec_s_bc( q, 'q' )
1868
1869	ENDIF
1870
1871	!
1872	!-- Scalar/q-tendency terms with no communication
1873	IF ( scalar_advec /= 'bc-scheme' ) THEN
1874	tend = 0.0_wp
1875	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1876	IF ( ws_scheme_sca ) THEN
1877	CALL advec_s_ws( q, 'q' )
1878	ELSE
1879	CALL advec_s_pw( q )
1880	ENDIF
1881	ELSE
1882	CALL advec_s_up( q )
1883	ENDIF
1884	ENDIF
1885
1886	CALL diffusion_s( q, &
1887	surf_def_h(0)%qsws, surf_def_h(1)%qsws, &
1888	surf_def_h(2)%qsws, &
1889	surf_lsm_h%qsws, surf_usm_h%qsws, &
1890	surf_def_v(0)%qsws, surf_def_v(1)%qsws, &
1891	surf_def_v(2)%qsws, surf_def_v(3)%qsws, &
1892	surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws, &
1893	surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws, &
1894	surf_usm_v(0)%qsws, surf_usm_v(1)%qsws, &
1895	surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
1896
1897	!
1898	!-- Sink or source of humidity due to canopy elements
1899	IF ( plant_canopy ) CALL pcm_tendency( 5 )
1900
1901	!
1902	!-- Large scale advection
1903	IF ( large_scale_forcing ) THEN
1904	CALL ls_advec( simulated_time, 'q' )
1905	ENDIF
1906
1907	!
1908	!-- Nudging
1909	IF ( nudging ) CALL nudge( simulated_time, 'q' )
1910
1911	!
1912	!-- If required compute influence of large-scale subsidence/ascent
1913	IF ( large_scale_subsidence .AND. &
1914	.NOT. use_subsidence_tendencies ) THEN
1915	CALL subsidence( tend, q, q_init, 3 )
1916	ENDIF
1917
1918	CALL user_actions( 'q-tendency' )
1919
1920	!
1921	!-- Prognostic equation for total water content
1922	DO i = nxl, nxr
1923	DO j = nys, nyn
1924	DO k = nzb+1, nzt
1925	q_p(k,j,i) = q(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
1926	tsc(3) * tq_m(k,j,i) ) &
1927	- tsc(5) * rdf_sc(k) * &
1928	( q(k,j,i) - q_init(k) ) &
1929	) * MERGE( 1.0_wp, 0.0_wp, &
1930	BTEST( wall_flags_0(k,j,i), 0 ) &
1931	)
1932	IF ( q_p(k,j,i) < 0.0_wp ) q_p(k,j,i) = 0.1_wp * q(k,j,i)
1933	ENDDO
1934	ENDDO
1935	ENDDO
1936
1937	!
1938	!-- Calculate tendencies for the next Runge-Kutta step
1939	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1940	IF ( intermediate_timestep_count == 1 ) THEN
1941	DO i = nxl, nxr
1942	DO j = nys, nyn
1943	DO k = nzb+1, nzt
1944	tq_m(k,j,i) = tend(k,j,i)
1945	ENDDO
1946	ENDDO
1947	ENDDO
1948	ELSEIF ( intermediate_timestep_count < &
1949	intermediate_timestep_count_max ) THEN
1950	DO i = nxl, nxr
1951	DO j = nys, nyn
1952	DO k = nzb+1, nzt
1953	tq_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
1954	+ 5.3125_wp * tq_m(k,j,i)
1955	ENDDO
1956	ENDDO
1957	ENDDO
1958	ENDIF
1959	ENDIF
1960
1961	CALL cpu_log( log_point(29), 'q-equation', 'stop' )
1962
1963	!
1964	!-- If required, calculate prognostic equations for cloud water content
1965	!-- and cloud drop concentration
1966	IF ( cloud_physics .AND. microphysics_morrison ) THEN
1967
1968	CALL cpu_log( log_point(67), 'qc-equation', 'start' )
1969
1970	!
1971	!-- Calculate prognostic equation for cloud water content
1972	sbt = tsc(2)
1973	IF ( scalar_advec == 'bc-scheme' ) THEN
1974
1975	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
1976	!
1977	!-- Bott-Chlond scheme always uses Euler time step. Thus:
1978	sbt = 1.0_wp
1979	ENDIF
1980	tend = 0.0_wp
1981	CALL advec_s_bc( qc, 'qc' )
1982
1983	ENDIF
1984
1985	!
1986	!-- qc-tendency terms with no communication
1987	IF ( scalar_advec /= 'bc-scheme' ) THEN
1988	tend = 0.0_wp
1989	IF ( timestep_scheme(1:5) == 'runge' ) THEN
1990	IF ( ws_scheme_sca ) THEN
1991	CALL advec_s_ws( qc, 'qc' )
1992	ELSE
1993	CALL advec_s_pw( qc )
1994	ENDIF
1995	ELSE
1996	CALL advec_s_up( qc )
1997	ENDIF
1998	ENDIF
1999
2000	CALL diffusion_s( qc, &
2001	surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, &
2002	surf_def_h(2)%qcsws, &
2003	surf_lsm_h%qcsws, surf_usm_h%qcsws, &
2004	surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, &
2005	surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, &
2006	surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, &
2007	surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, &
2008	surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, &
2009	surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )
2010
2011	!
2012	!-- Prognostic equation for cloud water content
2013	DO i = nxl, nxr
2014	DO j = nys, nyn
2015	DO k = nzb+1, nzt
2016	qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
2017	tsc(3) * tqc_m(k,j,i) ) &
2018	- tsc(5) * rdf_sc(k) * &
2019	qc(k,j,i) &
2020	) &
2021	* MERGE( 1.0_wp, 0.0_wp, &
2022	BTEST( wall_flags_0(k,j,i), 0 ) &
2023	)
2024	IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp
2025	ENDDO
2026	ENDDO
2027	ENDDO
2028
2029	!
2030	!-- Calculate tendencies for the next Runge-Kutta step
2031	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2032	IF ( intermediate_timestep_count == 1 ) THEN
2033	DO i = nxl, nxr
2034	DO j = nys, nyn
2035	DO k = nzb+1, nzt
2036	tqc_m(k,j,i) = tend(k,j,i)
2037	ENDDO
2038	ENDDO
2039	ENDDO
2040	ELSEIF ( intermediate_timestep_count < &
2041	intermediate_timestep_count_max ) THEN
2042	DO i = nxl, nxr
2043	DO j = nys, nyn
2044	DO k = nzb+1, nzt
2045	tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
2046	+ 5.3125_wp * tqc_m(k,j,i)
2047	ENDDO
2048	ENDDO
2049	ENDDO
2050	ENDIF
2051	ENDIF
2052
2053	CALL cpu_log( log_point(67), 'qc-equation', 'stop' )
2054	CALL cpu_log( log_point(68), 'nc-equation', 'start' )
2055
2056	!
2057	!-- Calculate prognostic equation for cloud drop concentration
2058	sbt = tsc(2)
2059	IF ( scalar_advec == 'bc-scheme' ) THEN
2060
2061	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
2062	!
2063	!-- Bott-Chlond scheme always uses Euler time step. Thus:
2064	sbt = 1.0_wp
2065	ENDIF
2066	tend = 0.0_wp
2067	CALL advec_s_bc( nc, 'nc' )
2068
2069	ENDIF
2070
2071	!
2072	!-- nc-tendency terms with no communication
2073	IF ( scalar_advec /= 'bc-scheme' ) THEN
2074	tend = 0.0_wp
2075	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2076	IF ( ws_scheme_sca ) THEN
2077	CALL advec_s_ws( nc, 'nc' )
2078	ELSE
2079	CALL advec_s_pw( nc )
2080	ENDIF
2081	ELSE
2082	CALL advec_s_up( nc )
2083	ENDIF
2084	ENDIF
2085
2086	CALL diffusion_s( nc, &
2087	surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, &
2088	surf_def_h(2)%ncsws, &
2089	surf_lsm_h%ncsws, surf_usm_h%ncsws, &
2090	surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, &
2091	surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, &
2092	surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, &
2093	surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, &
2094	surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, &
2095	surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )
2096
2097	!
2098	!-- Prognostic equation for cloud drop concentration
2099	DO i = nxl, nxr
2100	DO j = nys, nyn
2101	DO k = nzb+1, nzt
2102	nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
2103	tsc(3) * tnc_m(k,j,i) ) &
2104	- tsc(5) * rdf_sc(k) * &
2105	nc(k,j,i) &
2106	) &
2107	* MERGE( 1.0_wp, 0.0_wp, &
2108	BTEST( wall_flags_0(k,j,i), 0 ) &
2109	)
2110	IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp
2111	ENDDO
2112	ENDDO
2113	ENDDO
2114
2115	!
2116	!-- Calculate tendencies for the next Runge-Kutta step
2117	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2118	IF ( intermediate_timestep_count == 1 ) THEN
2119	DO i = nxl, nxr
2120	DO j = nys, nyn
2121	DO k = nzb+1, nzt
2122	tnc_m(k,j,i) = tend(k,j,i)
2123	ENDDO
2124	ENDDO
2125	ENDDO
2126	ELSEIF ( intermediate_timestep_count < &
2127	intermediate_timestep_count_max ) THEN
2128	DO i = nxl, nxr
2129	DO j = nys, nyn
2130	DO k = nzb+1, nzt
2131	tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
2132	+ 5.3125_wp * tnc_m(k,j,i)
2133	ENDDO
2134	ENDDO
2135	ENDDO
2136	ENDIF
2137	ENDIF
2138
2139	CALL cpu_log( log_point(68), 'nc-equation', 'stop' )
2140
2141	ENDIF
2142	!
2143	!-- If required, calculate prognostic equations for rain water content
2144	!-- and rain drop concentration
2145	IF ( cloud_physics .AND. microphysics_seifert ) THEN
2146
2147	CALL cpu_log( log_point(52), 'qr-equation', 'start' )
2148
2149	!
2150	!-- Calculate prognostic equation for rain water content
2151	sbt = tsc(2)
2152	IF ( scalar_advec == 'bc-scheme' ) THEN
2153
2154	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
2155	!
2156	!-- Bott-Chlond scheme always uses Euler time step. Thus:
2157	sbt = 1.0_wp
2158	ENDIF
2159	tend = 0.0_wp
2160	CALL advec_s_bc( qr, 'qr' )
2161
2162	ENDIF
2163
2164	!
2165	!-- qr-tendency terms with no communication
2166	IF ( scalar_advec /= 'bc-scheme' ) THEN
2167	tend = 0.0_wp
2168	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2169	IF ( ws_scheme_sca ) THEN
2170	CALL advec_s_ws( qr, 'qr' )
2171	ELSE
2172	CALL advec_s_pw( qr )
2173	ENDIF
2174	ELSE
2175	CALL advec_s_up( qr )
2176	ENDIF
2177	ENDIF
2178
2179	CALL diffusion_s( qr, &
2180	surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, &
2181	surf_def_h(2)%qrsws, &
2182	surf_lsm_h%qrsws, surf_usm_h%qrsws, &
2183	surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, &
2184	surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, &
2185	surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, &
2186	surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, &
2187	surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, &
2188	surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )
2189
2190	!
2191	!-- Prognostic equation for rain water content
2192	DO i = nxl, nxr
2193	DO j = nys, nyn
2194	DO k = nzb+1, nzt
2195	qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
2196	tsc(3) * tqr_m(k,j,i) ) &
2197	- tsc(5) * rdf_sc(k) * &
2198	qr(k,j,i) &
2199	) &
2200	* MERGE( 1.0_wp, 0.0_wp, &
2201	BTEST( wall_flags_0(k,j,i), 0 ) &
2202	)
2203	IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp
2204	ENDDO
2205	ENDDO
2206	ENDDO
2207
2208	!
2209	!-- Calculate tendencies for the next Runge-Kutta step
2210	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2211	IF ( intermediate_timestep_count == 1 ) THEN
2212	DO i = nxl, nxr
2213	DO j = nys, nyn
2214	DO k = nzb+1, nzt
2215	tqr_m(k,j,i) = tend(k,j,i)
2216	ENDDO
2217	ENDDO
2218	ENDDO
2219	ELSEIF ( intermediate_timestep_count < &
2220	intermediate_timestep_count_max ) THEN
2221	DO i = nxl, nxr
2222	DO j = nys, nyn
2223	DO k = nzb+1, nzt
2224	tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
2225	+ 5.3125_wp * tqr_m(k,j,i)
2226	ENDDO
2227	ENDDO
2228	ENDDO
2229	ENDIF
2230	ENDIF
2231
2232	CALL cpu_log( log_point(52), 'qr-equation', 'stop' )
2233	CALL cpu_log( log_point(53), 'nr-equation', 'start' )
2234
2235	!
2236	!-- Calculate prognostic equation for rain drop concentration
2237	sbt = tsc(2)
2238	IF ( scalar_advec == 'bc-scheme' ) THEN
2239
2240	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
2241	!
2242	!-- Bott-Chlond scheme always uses Euler time step. Thus:
2243	sbt = 1.0_wp
2244	ENDIF
2245	tend = 0.0_wp
2246	CALL advec_s_bc( nr, 'nr' )
2247
2248	ENDIF
2249
2250	!
2251	!-- nr-tendency terms with no communication
2252	IF ( scalar_advec /= 'bc-scheme' ) THEN
2253	tend = 0.0_wp
2254	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2255	IF ( ws_scheme_sca ) THEN
2256	CALL advec_s_ws( nr, 'nr' )
2257	ELSE
2258	CALL advec_s_pw( nr )
2259	ENDIF
2260	ELSE
2261	CALL advec_s_up( nr )
2262	ENDIF
2263	ENDIF
2264
2265	CALL diffusion_s( nr, &
2266	surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, &
2267	surf_def_h(2)%nrsws, &
2268	surf_lsm_h%nrsws, surf_usm_h%nrsws, &
2269	surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, &
2270	surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, &
2271	surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, &
2272	surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, &
2273	surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, &
2274	surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )
2275
2276	!
2277	!-- Prognostic equation for rain drop concentration
2278	DO i = nxl, nxr
2279	DO j = nys, nyn
2280	DO k = nzb+1, nzt
2281	nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
2282	tsc(3) * tnr_m(k,j,i) ) &
2283	- tsc(5) * rdf_sc(k) * &
2284	nr(k,j,i) &
2285	) &
2286	* MERGE( 1.0_wp, 0.0_wp, &
2287	BTEST( wall_flags_0(k,j,i), 0 ) &
2288	)
2289	IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp
2290	ENDDO
2291	ENDDO
2292	ENDDO
2293
2294	!
2295	!-- Calculate tendencies for the next Runge-Kutta step
2296	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2297	IF ( intermediate_timestep_count == 1 ) THEN
2298	DO i = nxl, nxr
2299	DO j = nys, nyn
2300	DO k = nzb+1, nzt
2301	tnr_m(k,j,i) = tend(k,j,i)
2302	ENDDO
2303	ENDDO
2304	ENDDO
2305	ELSEIF ( intermediate_timestep_count < &
2306	intermediate_timestep_count_max ) THEN
2307	DO i = nxl, nxr
2308	DO j = nys, nyn
2309	DO k = nzb+1, nzt
2310	tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
2311	+ 5.3125_wp * tnr_m(k,j,i)
2312	ENDDO
2313	ENDDO
2314	ENDDO
2315	ENDIF
2316	ENDIF
2317
2318	CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
2319
2320	ENDIF
2321
2322	ENDIF
2323	!
2324	!-- If required, compute prognostic equation for scalar
2325	IF ( passive_scalar ) THEN
2326
2327	CALL cpu_log( log_point(66), 's-equation', 'start' )
2328
2329	!
2330	!-- Scalar/q-tendency terms with communication
2331	sbt = tsc(2)
2332	IF ( scalar_advec == 'bc-scheme' ) THEN
2333
2334	IF ( timestep_scheme(1:5) /= 'runge' ) THEN
2335	!
2336	!-- Bott-Chlond scheme always uses Euler time step. Thus:
2337	sbt = 1.0_wp
2338	ENDIF
2339	tend = 0.0_wp
2340	CALL advec_s_bc( s, 's' )
2341
2342	ENDIF
2343
2344	!
2345	!-- Scalar/q-tendency terms with no communication
2346	IF ( scalar_advec /= 'bc-scheme' ) THEN
2347	tend = 0.0_wp
2348	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2349	IF ( ws_scheme_sca ) THEN
2350	CALL advec_s_ws( s, 's' )
2351	ELSE
2352	CALL advec_s_pw( s )
2353	ENDIF
2354	ELSE
2355	CALL advec_s_up( s )
2356	ENDIF
2357	ENDIF
2358
2359	CALL diffusion_s( s, &
2360	surf_def_h(0)%ssws, surf_def_h(1)%ssws, &
2361	surf_def_h(2)%ssws, &
2362	surf_lsm_h%ssws, surf_usm_h%ssws, &
2363	surf_def_v(0)%ssws, surf_def_v(1)%ssws, &
2364	surf_def_v(2)%ssws, surf_def_v(3)%ssws, &
2365	surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws, &
2366	surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws, &
2367	surf_usm_v(0)%ssws, surf_usm_v(1)%ssws, &
2368	surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
2369
2370	!
2371	!-- Sink or source of humidity due to canopy elements
2372	IF ( plant_canopy ) CALL pcm_tendency( 7 )
2373
2374	!
2375	!-- Large scale advection. Not implemented for scalars so far.
2376	! IF ( large_scale_forcing ) THEN
2377	! CALL ls_advec( simulated_time, 'q' )
2378	! ENDIF
2379
2380	!
2381	!-- Nudging. Not implemented for scalars so far.
2382	! IF ( nudging ) CALL nudge( simulated_time, 'q' )
2383
2384	!
2385	!-- If required compute influence of large-scale subsidence/ascent.
2386	!-- Not implemented for scalars so far.
2387	IF ( large_scale_subsidence .AND. &
2388	.NOT. use_subsidence_tendencies .AND. &
2389	.NOT. large_scale_forcing ) THEN
2390	CALL subsidence( tend, s, s_init, 3 )
2391	ENDIF
2392
2393	CALL user_actions( 's-tendency' )
2394
2395	!
2396	!-- Prognostic equation for total water content
2397	DO i = nxl, nxr
2398	DO j = nys, nyn
2399	DO k = nzb+1, nzt
2400	s_p(k,j,i) = s(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &
2401	tsc(3) * ts_m(k,j,i) ) &
2402	- tsc(5) * rdf_sc(k) * &
2403	( s(k,j,i) - s_init(k) ) &
2404	) &
2405	* MERGE( 1.0_wp, 0.0_wp, &
2406	BTEST( wall_flags_0(k,j,i), 0 ) &
2407	)
2408	IF ( s_p(k,j,i) < 0.0_wp ) s_p(k,j,i) = 0.1_wp * s(k,j,i)
2409	ENDDO
2410	ENDDO
2411	ENDDO
2412
2413	!
2414	!-- Calculate tendencies for the next Runge-Kutta step
2415	IF ( timestep_scheme(1:5) == 'runge' ) THEN
2416	IF ( intermediate_timestep_count == 1 ) THEN
2417	DO i = nxl, nxr
2418	DO j = nys, nyn
2419	DO k = nzb+1, nzt
2420	ts_m(k,j,i) = tend(k,j,i)
2421	ENDDO
2422	ENDDO
2423	ENDDO
2424	ELSEIF ( intermediate_timestep_count < &
2425	intermediate_timestep_count_max ) THEN
2426	DO i = nxl, nxr
2427	DO j = nys, nyn
2428	DO k = nzb+1, nzt
2429	ts_m(k,j,i) = -9.5625_wp * tend(k,j,i) &
2430	+ 5.3125_wp * ts_m(k,j,i)
2431	ENDDO
2432	ENDDO
2433	ENDDO
2434	ENDIF
2435	ENDIF
2436
2437	CALL cpu_log( log_point(66), 's-equation', 'stop' )
2438
2439	ENDIF
2440
2441	CALL tcm_prognostic()
2442
2443	!
2444	!-- If required, compute prognostic equation for chemical quantites
2445	IF ( air_chemistry ) THEN
2446	CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'start' )
2447	!
2448	!-- Loop over chemical species
2449	DO lsp = 1, nvar
2450	CALL chem_prognostic_equations ( chem_species(lsp)%conc_p, &
2451	chem_species(lsp)%conc, &
2452	chem_species(lsp)%tconc_m, &
2453	chem_species(lsp)%conc_pr_init, &
2454	lsp )
2455	ENDDO
2456
2457	CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'stop' )
2458	ENDIF ! Chemicals equations
2459
2460
2461	END SUBROUTINE prognostic_equations_vector
2462
2463
2464	END MODULE prognostic_equations_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |