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

Last change on this file since 2550 was 2320, checked in by suehring, 7 years ago

large-scale forcing and nudging modularized

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