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

Last change on this file since 4117 was 4110, checked in by suehring, 5 years ago

last changes documented

  • Property svn:keywords set to Id
File size: 67.8 KB
RevLine 
[1873]1!> @file prognostic_equations.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1875]4!
[2000]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.
[1875]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!
[3655]17! Copyright 1997-2019 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1875]19!
20! Current revisions:
21! ------------------
[4110]22!
23!
24! Former revisions:
25! -----------------
26! $Id: prognostic_equations.f90 4110 2019-07-22 17:05:21Z monakurppa $
[4109]27! pass integer flag array to WS scalar advection routine which is now necessary
28! as the flags may differ for scalars, e.g. pt can be cyclic while chemical
29! species may be non-cyclic. Further, pass boundary flags.
[2156]30!
[4110]31! 4109 2019-07-22 17:00:34Z suehring
[4079]32! Application of monotonic flux limiter for the vertical scalar advection
33! up to the topography top (only for the cache-optimized version at the
34! moment). Please note, at the moment the limiter is only applied for passive
35! scalars.
36!
37! 4048 2019-06-21 21:00:21Z knoop
[4048]38! Moved tcm_prognostic_equations to module_interface
39!
40! 3987 2019-05-22 09:52:13Z kanani
[3987]41! Introduce alternative switch for debug output during timestepping
42!
43! 3956 2019-05-07 12:32:52Z monakurppa
[3956]44! Removed salsa calls.
45!
46! 3931 2019-04-24 16:34:28Z schwenkel
[3929]47! Correct/complete module_interface introduction for chemistry model
48!
49! 3899 2019-04-16 14:05:27Z monakurppa
[3899]50! Corrections in the OpenMP version of salsa
[3929]51!
52! 3887 2019 -04-12 08:47:41Z schwenkel
[3887]53! Implicit Bugfix for chemistry model, loop for non_transport_physics over
54! ghost points is avoided. Instead introducing module_interface_exchange_horiz.
55!
56! 3885 2019-04-11 11:29:34Z kanani
[3885]57! Changes related to global restructuring of location messages and introduction
58! of additional debug messages
59!
60! 3881 2019-04-10 09:31:22Z suehring
[3881]61! Bugfix in OpenMP directive
62!
63! 3880 2019-04-08 21:43:02Z knoop
[3875]64! Moved wtm_tendencies to module_interface_actions
65!
66! 3874 2019-04-08 16:53:48Z knoop
[3874]67! Added non_transport_physics module interfaces and moved bcm code into it
68!
69! 3872 2019-04-08 15:03:06Z knoop
[3870]70! Moving prognostic equations of bcm into bulk_cloud_model_mod
71!
72! 3864 2019-04-05 09:01:56Z monakurppa
[3864]73! Modifications made for salsa:
74! - salsa_prognostic_equations moved to salsa_mod (and the call to
75!   module_interface_mod)
76! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and
77!   ngast --> ngases_salsa and loop indices b, c and sg to ib, ic and ig
78!
79! 3840 2019-03-29 10:35:52Z knoop
[3879]80! added USE chem_gasphase_mod for nspec, nspec and spc_names
[3833]81!
82! 3820 2019-03-27 11:53:41Z forkel
[3820]83! renamed do_depo to deposition_dry (ecc)
84!
85! 3797 2019-03-15 11:15:38Z forkel
[3797]86! Call chem_integegrate in OpenMP loop   (ketelsen)
87!
88!
89! 3771 2019-02-28 12:19:33Z raasch
[3771]90! preprocessor directivs fro rrtmg added
91!
92! 3761 2019-02-25 15:31:42Z raasch
[3761]93! unused variable removed
94!
95! 3719 2019-02-06 13:10:18Z kanani
[3719]96! Cleaned up chemistry cpu measurements
97!
98! 3684 2019-01-20 20:20:58Z knoop
[3634]99! OpenACC port for SPEC
100!
101! 3589 2018-11-30 15:09:51Z suehring
[3589]102! Move the control parameter "salsa" from salsa_mod to control_parameters
103! (M. Kurppa)
104!
105! 3582 2018-11-29 19:16:36Z suehring
[3467]106! Implementation of a new aerosol module salsa.
107! Remove cpu-logs from i,j loop in cache version.
108!
109! 3458 2018-10-30 14:51:23Z kanani
[3458]110! remove duplicate USE chem_modules
111! from chemistry branch r3443, banzhafs, basit:
112! chem_depo call introduced
113! code added for decycling chemistry
114!
115! 3386 2018-10-19 16:28:22Z gronemeier
[3386]116! Renamed tcm_prognostic to tcm_prognostic_equations
117!
118! 3355 2018-10-16 14:03:34Z knoop
[3337]119! (from branch resler)
120! Fix for chemistry call
121!
122! 3302 2018-10-03 02:39:40Z raasch
[3302]123! Stokes drift + wave breaking term added
124!
125! 3298 2018-10-02 12:21:11Z kanani
[3298]126! Code added for decycling chemistry (basit)
127!
128! 3294 2018-10-01 02:37:10Z raasch
[3294]129! changes concerning modularization of ocean option
130!
131! 3274 2018-09-24 15:42:55Z knoop
[3274]132! Modularization of all bulk cloud physics code components
133!
134! 3241 2018-09-12 15:02:00Z raasch
[3241]135! omp_get_thread_num now declared in omp directive
136!
137! 3183 2018-07-27 14:25:55Z suehring
[3183]138! Remove unused variables from USE statements
139!
140! 3182 2018-07-27 13:36:03Z suehring
[3022]141! Revise recent bugfix for nesting
142!
143! 3021 2018-05-16 08:14:20Z maronga
[3021]144! Bugfix in IF clause for nesting
145!
146! 3014 2018-05-09 08:42:38Z maronga
[3014]147! Fixed a bug in the IF condition to call pcm_tendency in case of
148! potential temperature
149!
150! 2815 2018-02-19 11:29:57Z kanani
[2815]151! Rename chem_tendency to chem_prognostic_equations,
152! implement vector version for air chemistry
153!
154! 2766 2018-01-22 17:17:47Z kanani
[2766]155! Removed preprocessor directive __chem
156!
157! 2746 2018-01-15 12:06:04Z suehring
[2746]158! Move flag plant canopy to modules
159!
160! 2719 2018-01-02 09:02:06Z maronga
[2719]161! Bugfix for last change.
162!
163! 2718 2018-01-02 08:49:38Z maronga
[2716]164! Corrected "Former revisions" section
165!
166! 2696 2017-12-14 17:12:51Z kanani
167! - Change in file header (GPL part)
[2696]168! - Moved TKE equation to tcm_prognostic (TG)
169! - Added switch for chemical reactions (RF, FK)
170! - Implementation of chemistry module (RF, BK, FK)
171!
172! 2563 2017-10-19 15:36:10Z Giersch
[2563]173! Variable wind_turbine moved to module control_parameters
174!
175! 2320 2017-07-21 12:47:43Z suehring
[2320]176! Modularize large-scale forcing and nudging
177!
178! 2292 2017-06-20 09:51:42Z schwenkel
[2292]179! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
180! includes two more prognostic equations for cloud drop concentration (nc) 
181! and cloud water content (qc).
182!
183! 2261 2017-06-08 14:25:57Z raasch
[2261]184! bugfix for r2232: openmp directives removed
185!
186! 2233 2017-05-30 18:08:54Z suehring
[1875]187!
[2233]188! 2232 2017-05-30 17:47:52Z suehring
189! Adjutst to new surface-type structure. Remove call for usm_wall_heat_flux,
190! which is realized directly in diffusion_s now.
191!
[2193]192! 2192 2017-03-22 04:14:10Z raasch
193! Bugfix for misplaced and missing openMP directives from r2155
194!
[2156]195! 2155 2017-02-21 09:57:40Z hoffmann
196! Bugfix in the calculation of microphysical quantities on ghost points.
197!
[2119]198! 2118 2017-01-17 16:38:49Z raasch
199! OpenACC version of subroutine removed
[2155]200!
[2032]201! 2031 2016-10-21 15:11:58Z knoop
202! renamed variable rho to rho_ocean
[2155]203!
[2012]204! 2011 2016-09-19 17:29:57Z kanani
205! Flag urban_surface is now defined in module control_parameters.
[2155]206!
[2008]207! 2007 2016-08-24 15:47:17Z kanani
208! Added pt tendency calculation based on energy balance at urban surfaces
209! (new urban surface model)
[2155]210!
[2001]211! 2000 2016-08-20 18:09:15Z knoop
212! Forced header and separation lines into 80 columns
[2155]213!
[1977]214! 1976 2016-07-27 13:28:04Z maronga
215! Simplied calls to radiation model
[2155]216!
[1961]217! 1960 2016-07-12 16:34:24Z suehring
218! Separate humidity and passive scalar
[2155]219!
[1917]220! 1914 2016-05-26 14:44:07Z witha
221! Added calls for wind turbine model
222!
[1874]223! 1873 2016-04-18 14:50:06Z maronga
224! Module renamed (removed _mod)
[2155]225!
[1851]226! 1850 2016-04-08 13:29:27Z maronga
227! Module renamed
[2155]228!
[1827]229! 1826 2016-04-07 12:01:39Z maronga
[1875]230! Renamed canopy model calls.
[2155]231!
[1875]232! 1822 2016-04-07 07:49:42Z hoffmann
233! Kessler microphysics scheme moved to microphysics.
234!
235! 1757 2016-02-22 15:49:32Z maronga
[2155]236!
[1875]237! 1691 2015-10-26 16:17:44Z maronga
238! Added optional model spin-up without radiation / land surface model calls.
239! Formatting corrections.
[2155]240!
[1875]241! 1682 2015-10-07 23:56:08Z knoop
[2155]242! Code annotations made doxygen readable
243!
[1875]244! 1585 2015-04-30 07:05:52Z maronga
245! Added call for temperature tendency calculation due to radiative flux divergence
[2155]246!
[1875]247! 1517 2015-01-07 19:12:25Z hoffmann
248! advec_s_bc_mod addded, since advec_s_bc is now a module
249!
250! 1484 2014-10-21 10:53:05Z kanani
251! Changes due to new module structure of the plant canopy model:
[2696]252! parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
[1875]253! Removed double-listing of use_upstream_for_tke in ONLY-list of module
254! control_parameters
[2155]255!
[1875]256! 1409 2014-05-23 12:11:32Z suehring
[2155]257! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary.
[1875]258! This ensures that left-hand side fluxes are also calculated for nxl in that
[2155]259! case, even though the solution at nxl is overwritten in boundary_conds()
260!
[1875]261! 1398 2014-05-07 11:15:00Z heinze
262! Rayleigh-damping for horizontal velocity components changed: instead of damping
[2155]263! against ug and vg, damping against u_init and v_init is used to allow for a
[1875]264! homogenized treatment in case of nudging
[2155]265!
[1875]266! 1380 2014-04-28 12:40:45Z heinze
[2155]267! Change order of calls for scalar prognostic quantities:
268! ls_advec -> nudging -> subsidence since initial profiles
269!
[1875]270! 1374 2014-04-25 12:55:07Z raasch
271! missing variables added to ONLY lists
[2155]272!
[1875]273! 1365 2014-04-22 15:03:56Z boeske
[2155]274! Calls of ls_advec for large scale advection added,
[1875]275! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
276! new argument ls_index added to the calls of subsidence
277! +ls_index
[2155]278!
[1875]279! 1361 2014-04-16 15:17:48Z hoffmann
280! Two-moment microphysics moved to the start of prognostic equations. This makes
281! the 3d arrays for tend_q, tend_qr, tend_pt and tend_pt redundant.
282! Additionally, it is allowed to call the microphysics just once during the time
283! step (not at each sub-time step).
284!
285! Two-moment cloud physics added for vector and accelerator optimization.
[2155]286!
[1875]287! 1353 2014-04-08 15:21:23Z heinze
288! REAL constants provided with KIND-attribute
[2155]289!
[1875]290! 1337 2014-03-25 15:11:48Z heinze
291! Bugfix: REAL constants provided with KIND-attribute
[2155]292!
[1875]293! 1332 2014-03-25 11:59:43Z suehring
[2155]294! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke
295!
[1875]296! 1330 2014-03-24 17:29:32Z suehring
[2155]297! In case of SGS-particle velocity advection of TKE is also allowed with
[1875]298! dissipative 5th-order scheme.
299!
300! 1320 2014-03-20 08:40:49Z raasch
301! ONLY-attribute added to USE-statements,
302! kind-parameters added to all INTEGER and REAL declaration statements,
303! kinds are defined in new module kinds,
304! old module precision_kind is removed,
305! revision history before 2012 removed,
306! comment fields (!:) to be used for variable explanations added to
307! all variable declaration statements
308!
309! 1318 2014-03-17 13:35:16Z raasch
310! module interfaces removed
311!
312! 1257 2013-11-08 15:18:40Z raasch
313! openacc loop vector clauses removed, independent clauses added
314!
315! 1246 2013-11-01 08:59:45Z heinze
316! enable nudging also for accelerator version
317!
318! 1241 2013-10-30 11:36:58Z heinze
319! usage of nudging enabled (so far not implemented for accelerator version)
320!
321! 1179 2013-06-14 05:57:58Z raasch
322! two arguments removed from routine buoyancy, ref_state updated on device
323!
324! 1128 2013-04-12 06:19:32Z raasch
325! those parts requiring global communication moved to time_integration,
326! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
327! j_north
328!
329! 1115 2013-03-26 18:16:16Z hoffmann
[2155]330! optimized cloud physics: calculation of microphysical tendencies transfered
[1875]331! to microphysics.f90; qr and nr are only calculated if precipitation is required
332!
333! 1111 2013-03-08 23:54:10Z raasch
334! update directives for prognostic quantities removed
335!
336! 1106 2013-03-04 05:31:38Z raasch
337! small changes in code formatting
338!
339! 1092 2013-02-02 11:24:22Z raasch
340! unused variables removed
341!
342! 1053 2012-11-13 17:11:03Z hoffmann
343! implementation of two new prognostic equations for rain drop concentration (nr)
344! and rain water content (qr)
345!
346! currently, only available for cache loop optimization
347!
348! 1036 2012-10-22 13:43:42Z raasch
349! code put under GPL (PALM 3.9)
350!
351! 1019 2012-09-28 06:46:45Z raasch
352! non-optimized version of prognostic_equations removed
353!
354! 1015 2012-09-27 09:23:24Z raasch
355! new branch prognostic_equations_acc
356! OpenACC statements added + code changes required for GPU optimization
357!
358! 1001 2012-09-13 14:08:46Z raasch
359! all actions concerning leapfrog- and upstream-spline-scheme removed
360!
361! 978 2012-08-09 08:28:32Z fricke
362! km_damp_x and km_damp_y removed in calls of diffusion_u and diffusion_v
363! add ptdf_x, ptdf_y for damping the potential temperature at the inflow
364! boundary in case of non-cyclic lateral boundaries
365! Bugfix: first thread index changes for WS-scheme at the inflow
366!
367! 940 2012-07-09 14:31:00Z raasch
368! temperature equation can be switched off
369!
370! Revision 1.1  2000/04/13 14:56:27  schroeter
371! Initial revision
372!
373!
374! Description:
375! ------------
376!> Solving the prognostic equations.
377!------------------------------------------------------------------------------!
378 MODULE prognostic_equations_mod
379
[3294]380    USE advec_s_bc_mod,                                                        &
381        ONLY:  advec_s_bc
[2155]382
[3294]383    USE advec_s_pw_mod,                                                        &
384        ONLY:  advec_s_pw
385
386    USE advec_s_up_mod,                                                        &
387        ONLY:  advec_s_up
388
389    USE advec_u_pw_mod,                                                        &
390        ONLY:  advec_u_pw
391
392    USE advec_u_up_mod,                                                        &
393        ONLY:  advec_u_up
394
395    USE advec_v_pw_mod,                                                        &
396        ONLY:  advec_v_pw
397
398    USE advec_v_up_mod,                                                        &
399        ONLY:  advec_v_up
400
401    USE advec_w_pw_mod,                                                        &
402        ONLY:  advec_w_pw
403
404    USE advec_w_up_mod,                                                        &
405        ONLY:  advec_w_up
406
407    USE advec_ws,                                                              &
408        ONLY:  advec_s_ws, advec_u_ws, advec_v_ws, advec_w_ws
409
[1875]410    USE arrays_3d,                                                             &
[3870]411        ONLY:  diss_l_e, diss_l_pt, diss_l_q,                                  &
412               diss_l_s, diss_l_sa, diss_s_e,                                  &
413               diss_s_pt, diss_s_q, diss_s_s, diss_s_sa,                       &
414               e, e_p, flux_s_e, flux_s_pt, flux_s_q,                          &
415               flux_s_s, flux_s_sa, flux_l_e,                                  &
416               flux_l_pt, flux_l_q, flux_l_s,                                  &
417               flux_l_sa, pt, ptdf_x, ptdf_y, pt_init,                         &
418               pt_p, prho, q, q_init, q_p, rdf, rdf_sc,                        &
419               ref_state, rho_ocean, s, s_init, s_p, tend, te_m,               &
420               tpt_m, tq_m, ts_m, tu_m, tv_m, tw_m, u,                         &
[3294]421               ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
[2155]422
[3294]423    USE buoyancy_mod,                                                          &
424        ONLY:  buoyancy
[3864]425
[1875]426    USE control_parameters,                                                    &
[4109]427        ONLY:  bc_dirichlet_l,                                                 &
428               bc_dirichlet_n,                                                 &
429               bc_dirichlet_r,                                                 &
430               bc_dirichlet_s,                                                 &
431               bc_radiation_l,                                                 &
432               bc_radiation_n,                                                 &
433               bc_radiation_r,                                                 &
434               bc_radiation_s,                                                 &
435               constant_diffusion,                                             &
[3987]436               debug_output_timestep,                                          &
[2696]437               dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d,    &
[3182]438               humidity, intermediate_timestep_count,                          &
[1875]439               intermediate_timestep_count_max, large_scale_forcing,           &
[4079]440               large_scale_subsidence,                                         &
441               monotonic_limiter_z,                                            &
442               neutral, nudging,                                               &
[3294]443               ocean_mode, passive_scalar, plant_canopy, pt_reference,         &
[1875]444               scalar_advec, scalar_advec, simulated_time, sloping_surface,    &
[2232]445               timestep_scheme, tsc, use_subsidence_tendencies,                &
[2563]446               use_upstream_for_tke, wind_turbine, ws_scheme_mom,              & 
[3467]447               ws_scheme_sca, urban_surface, land_surface,                     &
[3582]448               time_since_reference_point, salsa
[1875]449
[3294]450    USE coriolis_mod,                                                          &
451        ONLY:  coriolis
452
[1875]453    USE cpulog,                                                                &
[2696]454        ONLY:  cpu_log, log_point, log_point_s
[1875]455
456    USE diffusion_s_mod,                                                       &
[2118]457        ONLY:  diffusion_s
[1875]458
459    USE diffusion_u_mod,                                                       &
[2118]460        ONLY:  diffusion_u
[1875]461
462    USE diffusion_v_mod,                                                       &
[2118]463        ONLY:  diffusion_v
[1875]464
465    USE diffusion_w_mod,                                                       &
[2118]466        ONLY:  diffusion_w
[1875]467
[3294]468    USE indices,                                                               &
[4109]469        ONLY:  advc_flags_s,                                                   &
470               nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv,   &
[3294]471               nzb, nzt, wall_flags_0
472
[1875]473    USE kinds
474
[2320]475    USE lsf_nudging_mod,                                                       &
476        ONLY:  ls_advec, nudge
[1875]477
[3684]478    USE module_interface,                                                      &
[3837]479        ONLY:  module_interface_actions, &
[3931]480               module_interface_non_advective_processes, &
[3887]481               module_interface_exchange_horiz, &
[3837]482               module_interface_prognostic_equations
[3684]483
[3294]484    USE ocean_mod,                                                             &
[3840]485        ONLY:  stokes_drift_terms, stokes_force,   &
[3302]486               wave_breaking, wave_breaking_term
[3294]487
[1875]488    USE plant_canopy_model_mod,                                                &
[2746]489        ONLY:  cthf, pcm_tendency
[1875]490
[3771]491#if defined( __rrtmg )
[1875]492    USE radiation_model_mod,                                                   &
[1976]493        ONLY:  radiation, radiation_tendency,                                  &
[1875]494               skip_time_do_radiation
[3771]495#endif
[3864]496
[1875]497    USE statistics,                                                            &
498        ONLY:  hom
499
500    USE subsidence_mod,                                                        &
501        ONLY:  subsidence
502
[3294]503    USE surface_mod,                                                           &
504        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,    &
505                surf_usm_v
506
[3874]507    IMPLICIT NONE
[1914]508
[1875]509    PRIVATE
[2118]510    PUBLIC prognostic_equations_cache, prognostic_equations_vector
[1875]511
512    INTERFACE prognostic_equations_cache
513       MODULE PROCEDURE prognostic_equations_cache
514    END INTERFACE prognostic_equations_cache
515
516    INTERFACE prognostic_equations_vector
517       MODULE PROCEDURE prognostic_equations_vector
518    END INTERFACE prognostic_equations_vector
519
520
521 CONTAINS
522
523
524!------------------------------------------------------------------------------!
525! Description:
526! ------------
527!> Version with one optimized loop over all equations. It is only allowed to
528!> be called for the Wicker and Skamarock or Piascek-Williams advection scheme.
529!>
530!> Here the calls of most subroutines are embedded in two DO loops over i and j,
531!> so communication between CPUs is not allowed (does not make sense) within
532!> these loops.
533!>
534!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
535!------------------------------------------------------------------------------!
[2155]536
[1875]537 SUBROUTINE prognostic_equations_cache
538
539
540    INTEGER(iwp) ::  i                   !<
541    INTEGER(iwp) ::  i_omp_start         !<
542    INTEGER(iwp) ::  j                   !<
543    INTEGER(iwp) ::  k                   !<
[3241]544!$  INTEGER(iwp) ::  omp_get_thread_num  !<
[1875]545    INTEGER(iwp) ::  tn = 0              !<
[2155]546
[1875]547    LOGICAL      ::  loop_start          !<
548
549
[3987]550    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'start' )
[1875]551!
552!-- Time measurement can only be performed for the whole set of equations
553    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
554
[3878]555    !$OMP PARALLEL PRIVATE (i,j)
556    !$OMP DO
[3887]557    DO  i = nxl, nxr
558       DO  j = nys, nyn
[1875]559!
[3931]560!--       Calculate non advective processes for all other modules
561          CALL module_interface_non_advective_processes( i, j )
[3878]562       ENDDO
563    ENDDO
[3887]564!
[3931]565!-- Module Inferface for exchange horiz after non_advective_processes but before
[3956]566!-- advection. Therefore, non_advective_processes must not run for ghost points.
567    !$OMP END PARALLEL
[3887]568    CALL module_interface_exchange_horiz()
[2696]569!
[2192]570!-- Loop over all prognostic equations
[3881]571    !$OMP PARALLEL PRIVATE (i,i_omp_start,j,k,loop_start,tn)
[2192]572
573    !$  tn = omp_get_thread_num()
574    loop_start = .TRUE.
575
576    !$OMP DO
[1875]577    DO  i = nxl, nxr
578
579!
580!--    Store the first loop index. It differs for each thread and is required
581!--    later in advec_ws
582       IF ( loop_start )  THEN
583          loop_start  = .FALSE.
[2155]584          i_omp_start = i
[1875]585       ENDIF
586
587       DO  j = nys, nyn
588!
[3022]589!--       Tendency terms for u-velocity component. Please note, in case of
590!--       non-cyclic boundary conditions the grid point i=0 is excluded from
[3899]591!--       the prognostic equations for the u-component.
[3022]592          IF ( i >= nxlu )  THEN
[1875]593
594             tend(:,j,i) = 0.0_wp
595             IF ( timestep_scheme(1:5) == 'runge' )  THEN
596                IF ( ws_scheme_mom )  THEN
597                   CALL advec_u_ws( i, j, i_omp_start, tn )
[2155]598                ELSE
[1875]599                   CALL advec_u_pw( i, j )
[2155]600                ENDIF
[1875]601             ELSE
602                CALL advec_u_up( i, j )
603             ENDIF
604             CALL diffusion_u( i, j )
605             CALL coriolis( i, j, 1 )
606             IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
607                CALL buoyancy( i, j, pt, 1 )
608             ENDIF
609
610!
611!--          Drag by plant canopy
612             IF ( plant_canopy )  CALL pcm_tendency( i, j, 1 )
613
614!
615!--          External pressure gradient
616             IF ( dp_external )  THEN
617                DO  k = dp_level_ind_b+1, nzt
618                   tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
619                ENDDO
620             ENDIF
621
622!
623!--          Nudging
624             IF ( nudging )  CALL nudge( i, j, simulated_time, 'u' )
625
[1914]626!
[3302]627!--          Effect of Stokes drift (in ocean mode only)
628             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 1 )
629
[3684]630             CALL module_interface_actions( i, j, 'u-tendency' )
[1875]631!
632!--          Prognostic equation for u-velocity component
[2232]633             DO  k = nzb+1, nzt
634
635                u_p(k,j,i) = u(k,j,i) + ( dt_3d *                               &
636                                            ( tsc(2) * tend(k,j,i) +            &
637                                              tsc(3) * tu_m(k,j,i) )            &
638                                            - tsc(5) * rdf(k)                   &
639                                                     * ( u(k,j,i) - u_init(k) ) &
640                                        ) * MERGE( 1.0_wp, 0.0_wp,              &
641                                                   BTEST( wall_flags_0(k,j,i), 1 )&
642                                                 )
[1875]643             ENDDO
644
645!
[3302]646!--          Add turbulence generated by wave breaking (in ocean mode only)
647             IF ( wave_breaking  .AND.                                         &
648               intermediate_timestep_count == intermediate_timestep_count_max )&
649             THEN
650                CALL wave_breaking_term( i, j, 1 )
651             ENDIF
652
653!
[1875]654!--          Calculate tendencies for the next Runge-Kutta step
655             IF ( timestep_scheme(1:5) == 'runge' )  THEN
656                IF ( intermediate_timestep_count == 1 )  THEN
[2232]657                   DO  k = nzb+1, nzt
[1875]658                      tu_m(k,j,i) = tend(k,j,i)
659                   ENDDO
660                ELSEIF ( intermediate_timestep_count < &
661                         intermediate_timestep_count_max )  THEN
[2232]662                   DO  k = nzb+1, nzt
663                      tu_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                &
664                                     + 5.3125_wp * tu_m(k,j,i)
[1875]665                   ENDDO
666                ENDIF
667             ENDIF
668
669          ENDIF
670!
[3022]671!--       Tendency terms for v-velocity component. Please note, in case of
672!--       non-cyclic boundary conditions the grid point j=0 is excluded from
673!--       the prognostic equations for the v-component. !--       
674          IF ( j >= nysv )  THEN
[1875]675
676             tend(:,j,i) = 0.0_wp
677             IF ( timestep_scheme(1:5) == 'runge' )  THEN
678                IF ( ws_scheme_mom )  THEN
679                    CALL advec_v_ws( i, j, i_omp_start, tn )
[2155]680                ELSE
[1875]681                    CALL advec_v_pw( i, j )
682                ENDIF
683             ELSE
684                CALL advec_v_up( i, j )
685             ENDIF
686             CALL diffusion_v( i, j )
687             CALL coriolis( i, j, 2 )
688
689!
690!--          Drag by plant canopy
[2155]691             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )
[1875]692
693!
694!--          External pressure gradient
695             IF ( dp_external )  THEN
696                DO  k = dp_level_ind_b+1, nzt
697                   tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
698                ENDDO
699             ENDIF
700
701!
702!--          Nudging
703             IF ( nudging )  CALL nudge( i, j, simulated_time, 'v' )
704
[1914]705!
[3302]706!--          Effect of Stokes drift (in ocean mode only)
707             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 2 )
708
[3684]709             CALL module_interface_actions( i, j, 'v-tendency' )
[1875]710!
711!--          Prognostic equation for v-velocity component
[2232]712             DO  k = nzb+1, nzt
713                v_p(k,j,i) = v(k,j,i) + ( dt_3d *                              &
714                                            ( tsc(2) * tend(k,j,i) +           &
715                                              tsc(3) * tv_m(k,j,i) )           &
716                                            - tsc(5) * rdf(k)                  &
717                                                     * ( v(k,j,i) - v_init(k) )&
718                                        ) * MERGE( 1.0_wp, 0.0_wp,             &
719                                                   BTEST( wall_flags_0(k,j,i), 2 )&
720                                                 )
[1875]721             ENDDO
722
723!
[3302]724!--          Add turbulence generated by wave breaking (in ocean mode only)
725             IF ( wave_breaking  .AND.                                         &
726               intermediate_timestep_count == intermediate_timestep_count_max )&
727             THEN
728                CALL wave_breaking_term( i, j, 2 )
729             ENDIF
730
731!
[1875]732!--          Calculate tendencies for the next Runge-Kutta step
733             IF ( timestep_scheme(1:5) == 'runge' )  THEN
734                IF ( intermediate_timestep_count == 1 )  THEN
[2232]735                   DO  k = nzb+1, nzt
[1875]736                      tv_m(k,j,i) = tend(k,j,i)
737                   ENDDO
738                ELSEIF ( intermediate_timestep_count < &
739                         intermediate_timestep_count_max )  THEN
[2232]740                   DO  k = nzb+1, nzt
741                      tv_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                 &
742                                     + 5.3125_wp * tv_m(k,j,i)
[1875]743                   ENDDO
744                ENDIF
745             ENDIF
746
747          ENDIF
748
749!
750!--       Tendency terms for w-velocity component
751          tend(:,j,i) = 0.0_wp
752          IF ( timestep_scheme(1:5) == 'runge' )  THEN
753             IF ( ws_scheme_mom )  THEN
754                CALL advec_w_ws( i, j, i_omp_start, tn )
[2155]755             ELSE
[1875]756                CALL advec_w_pw( i, j )
757             END IF
758          ELSE
759             CALL advec_w_up( i, j )
760          ENDIF
761          CALL diffusion_w( i, j )
762          CALL coriolis( i, j, 3 )
763
764          IF ( .NOT. neutral )  THEN
[3294]765             IF ( ocean_mode )  THEN
[2031]766                CALL buoyancy( i, j, rho_ocean, 3 )
[1875]767             ELSE
768                IF ( .NOT. humidity )  THEN
769                   CALL buoyancy( i, j, pt, 3 )
770                ELSE
771                   CALL buoyancy( i, j, vpt, 3 )
772                ENDIF
773             ENDIF
774          ENDIF
775
776!
777!--       Drag by plant canopy
778          IF ( plant_canopy )  CALL pcm_tendency( i, j, 3 )
779
[1914]780!
[3302]781!--       Effect of Stokes drift (in ocean mode only)
782          IF ( stokes_force )  CALL stokes_drift_terms( i, j, 3 )
783
[3684]784          CALL module_interface_actions( i, j, 'w-tendency' )
[1875]785!
786!--       Prognostic equation for w-velocity component
[2232]787          DO  k = nzb+1, nzt-1
788             w_p(k,j,i) = w(k,j,i) + ( dt_3d *                                 &
789                                             ( tsc(2) * tend(k,j,i) +          &
[1875]790                                               tsc(3) * tw_m(k,j,i) )          &
[2232]791                                             - tsc(5) * rdf(k) * w(k,j,i)      &
792                                     ) * MERGE( 1.0_wp, 0.0_wp,                &
793                                                BTEST( wall_flags_0(k,j,i), 3 )&
794                                              )
[1875]795          ENDDO
796
797!
798!--       Calculate tendencies for the next Runge-Kutta step
799          IF ( timestep_scheme(1:5) == 'runge' )  THEN
800             IF ( intermediate_timestep_count == 1 )  THEN
[2232]801                DO  k = nzb+1, nzt-1
[1875]802                   tw_m(k,j,i) = tend(k,j,i)
803                ENDDO
804             ELSEIF ( intermediate_timestep_count < &
805                      intermediate_timestep_count_max )  THEN
[2232]806                DO  k = nzb+1, nzt-1
807                   tw_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                    &
808                                  + 5.3125_wp * tw_m(k,j,i)
[1875]809                ENDDO
810             ENDIF
811          ENDIF
812
813!
814!--       If required, compute prognostic equation for potential temperature
815          IF ( .NOT. neutral )  THEN
816!
817!--          Tendency terms for potential temperature
818             tend(:,j,i) = 0.0_wp
819             IF ( timestep_scheme(1:5) == 'runge' )  THEN
820                   IF ( ws_scheme_sca )  THEN
[4109]821                      CALL advec_s_ws( advc_flags_s,                           &
822                                       i, j, pt, 'pt', flux_s_pt, diss_s_pt,   &
823                                       flux_l_pt, diss_l_pt, i_omp_start, tn,  &
824                                       bc_dirichlet_l  .OR.  bc_radiation_l,   &
825                                       bc_dirichlet_n  .OR.  bc_radiation_n,   &
826                                       bc_dirichlet_r  .OR.  bc_radiation_r,   &
827                                       bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]828                   ELSE
829                      CALL advec_s_pw( i, j, pt )
830                   ENDIF
831             ELSE
832                CALL advec_s_up( i, j, pt )
833             ENDIF
[2232]834             CALL diffusion_s( i, j, pt,                                       &
835                               surf_def_h(0)%shf, surf_def_h(1)%shf,           &
836                               surf_def_h(2)%shf,                              &
837                               surf_lsm_h%shf,    surf_usm_h%shf,              &
838                               surf_def_v(0)%shf, surf_def_v(1)%shf,           &
839                               surf_def_v(2)%shf, surf_def_v(3)%shf,           &
840                               surf_lsm_v(0)%shf, surf_lsm_v(1)%shf,           &
841                               surf_lsm_v(2)%shf, surf_lsm_v(3)%shf,           &
842                               surf_usm_v(0)%shf, surf_usm_v(1)%shf,           &
843                               surf_usm_v(2)%shf, surf_usm_v(3)%shf )
[1875]844
845!
846!--          Consideration of heat sources within the plant canopy
[3014]847             IF ( plant_canopy  .AND.                                          &
848                (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  THEN
[1875]849                CALL pcm_tendency( i, j, 4 )
850             ENDIF
851
852!
853!--          Large scale advection
854             IF ( large_scale_forcing )  THEN
855                CALL ls_advec( i, j, simulated_time, 'pt' )
[2155]856             ENDIF
[1875]857
858!
859!--          Nudging
[2155]860             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' )
[1875]861
862!
863!--          If required, compute effect of large-scale subsidence/ascent
864             IF ( large_scale_subsidence  .AND.                                &
865                  .NOT. use_subsidence_tendencies )  THEN
866                CALL subsidence( i, j, tend, pt, pt_init, 2 )
867             ENDIF
868
[3771]869#if defined( __rrtmg )
[1875]870!
871!--          If required, add tendency due to radiative heating/cooling
[1976]872             IF ( radiation  .AND.                                             &
[1875]873                  simulated_time > skip_time_do_radiation )  THEN
874                CALL radiation_tendency ( i, j, tend )
875             ENDIF
[3771]876#endif
[1875]877
[3684]878             CALL module_interface_actions( i, j, 'pt-tendency' )
[1875]879!
880!--          Prognostic equation for potential temperature
[2232]881             DO  k = nzb+1, nzt
882                pt_p(k,j,i) = pt(k,j,i) + ( dt_3d *                            &
883                                                  ( tsc(2) * tend(k,j,i) +     &
[1875]884                                                    tsc(3) * tpt_m(k,j,i) )    &
[2232]885                                                  - tsc(5)                     &
886                                                  * ( pt(k,j,i) - pt_init(k) ) &
887                                                  * ( rdf_sc(k) + ptdf_x(i)    &
888                                                                + ptdf_y(j) )  &
889                                          )                                    &
890                                       * MERGE( 1.0_wp, 0.0_wp,                &
891                                                BTEST( wall_flags_0(k,j,i), 0 )&
892                                              )
[1875]893             ENDDO
894
895!
896!--          Calculate tendencies for the next Runge-Kutta step
897             IF ( timestep_scheme(1:5) == 'runge' )  THEN
898                IF ( intermediate_timestep_count == 1 )  THEN
[2232]899                   DO  k = nzb+1, nzt
[1875]900                      tpt_m(k,j,i) = tend(k,j,i)
901                   ENDDO
902                ELSEIF ( intermediate_timestep_count < &
903                         intermediate_timestep_count_max )  THEN
[2232]904                   DO  k = nzb+1, nzt
905                      tpt_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +              &
906                                        5.3125_wp * tpt_m(k,j,i)
[1875]907                   ENDDO
908                ENDIF
909             ENDIF
910
911          ENDIF
912
913!
[1960]914!--       If required, compute prognostic equation for total water content
915          IF ( humidity )  THEN
[1875]916
917!
918!--          Tendency-terms for total water content / scalar
919             tend(:,j,i) = 0.0_wp
[4109]920             IF ( timestep_scheme(1:5) == 'runge' )                            &
[1875]921             THEN
922                IF ( ws_scheme_sca )  THEN
[4109]923                   CALL advec_s_ws( advc_flags_s,                              &
924                                    i, j, q, 'q', flux_s_q,                    &
925                                    diss_s_q, flux_l_q, diss_l_q,              &
926                                    i_omp_start, tn,                           &
927                                    bc_dirichlet_l  .OR.  bc_radiation_l,      &
928                                    bc_dirichlet_n  .OR.  bc_radiation_n,      &
929                                    bc_dirichlet_r  .OR.  bc_radiation_r,      &
930                                    bc_dirichlet_s  .OR.  bc_radiation_s )
[2155]931                ELSE
[1875]932                   CALL advec_s_pw( i, j, q )
933                ENDIF
934             ELSE
935                CALL advec_s_up( i, j, q )
936             ENDIF
[2232]937             CALL diffusion_s( i, j, q,                                        &
938                               surf_def_h(0)%qsws, surf_def_h(1)%qsws,         &
939                               surf_def_h(2)%qsws,                             &
940                               surf_lsm_h%qsws,    surf_usm_h%qsws,            &
941                               surf_def_v(0)%qsws, surf_def_v(1)%qsws,         &
942                               surf_def_v(2)%qsws, surf_def_v(3)%qsws,         &
943                               surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws,         &
944                               surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws,         &
945                               surf_usm_v(0)%qsws, surf_usm_v(1)%qsws,         &
946                               surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
[1875]947
948!
[1960]949!--          Sink or source of humidity due to canopy elements
[1875]950             IF ( plant_canopy )  CALL pcm_tendency( i, j, 5 )
951
952!
953!--          Large scale advection
954             IF ( large_scale_forcing )  THEN
955                CALL ls_advec( i, j, simulated_time, 'q' )
956             ENDIF
957
958!
959!--          Nudging
[2155]960             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' )
[1875]961
962!
963!--          If required compute influence of large-scale subsidence/ascent
964             IF ( large_scale_subsidence  .AND.                                &
965                  .NOT. use_subsidence_tendencies )  THEN
966                CALL subsidence( i, j, tend, q, q_init, 3 )
967             ENDIF
968
[3684]969             CALL module_interface_actions( i, j, 'q-tendency' )
[1875]970
971!
972!--          Prognostic equation for total water content / scalar
[2232]973             DO  k = nzb+1, nzt
974                q_p(k,j,i) = q(k,j,i) + ( dt_3d *                              &
975                                                ( tsc(2) * tend(k,j,i) +       &
[1875]976                                                  tsc(3) * tq_m(k,j,i) )       &
[2232]977                                                - tsc(5) * rdf_sc(k) *         &
978                                                      ( q(k,j,i) - q_init(k) ) &
979                                        )                                      &
980                                       * MERGE( 1.0_wp, 0.0_wp,                &
981                                                BTEST( wall_flags_0(k,j,i), 0 )&
982                                              )               
[1875]983                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
984             ENDDO
985
986!
987!--          Calculate tendencies for the next Runge-Kutta step
988             IF ( timestep_scheme(1:5) == 'runge' )  THEN
989                IF ( intermediate_timestep_count == 1 )  THEN
[2232]990                   DO  k = nzb+1, nzt
[1875]991                      tq_m(k,j,i) = tend(k,j,i)
992                   ENDDO
993                ELSEIF ( intermediate_timestep_count < &
994                         intermediate_timestep_count_max )  THEN
[2232]995                   DO  k = nzb+1, nzt
996                      tq_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +               &
997                                       5.3125_wp * tq_m(k,j,i)
[1875]998                   ENDDO
999                ENDIF
1000             ENDIF
1001
1002          ENDIF
[2155]1003
[1960]1004!
1005!--       If required, compute prognostic equation for scalar
1006          IF ( passive_scalar )  THEN
1007!
1008!--          Tendency-terms for total water content / scalar
1009             tend(:,j,i) = 0.0_wp
[4109]1010             IF ( timestep_scheme(1:5) == 'runge' )                            &
[1960]1011             THEN
1012                IF ( ws_scheme_sca )  THEN
[4079]1013!
1014!--                For scalar advection apply monotonic flux limiter near
1015!--                topography.
[4109]1016                   CALL advec_s_ws( advc_flags_s,                              &
1017                                    i, j, s, 's', flux_s_s,                    &
[4079]1018                                    diss_s_s, flux_l_s, diss_l_s, i_omp_start, &
[4109]1019                                    tn,                                        &
1020                                    bc_dirichlet_l  .OR.  bc_radiation_l,      &
1021                                    bc_dirichlet_n  .OR.  bc_radiation_n,      &
1022                                    bc_dirichlet_r  .OR.  bc_radiation_r,      &
1023                                    bc_dirichlet_s  .OR.  bc_radiation_s,      &
1024                                    monotonic_limiter_z )
[2155]1025                ELSE
[1960]1026                   CALL advec_s_pw( i, j, s )
1027                ENDIF
1028             ELSE
1029                CALL advec_s_up( i, j, s )
1030             ENDIF
[2232]1031             CALL diffusion_s( i, j, s,                                        &
1032                               surf_def_h(0)%ssws, surf_def_h(1)%ssws,         &
1033                               surf_def_h(2)%ssws,                             &
1034                               surf_lsm_h%ssws,    surf_usm_h%ssws,            &
1035                               surf_def_v(0)%ssws, surf_def_v(1)%ssws,         &
1036                               surf_def_v(2)%ssws, surf_def_v(3)%ssws,         &
1037                               surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws,         &
1038                               surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws,         &
1039                               surf_usm_v(0)%ssws, surf_usm_v(1)%ssws,         &
1040                               surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
[1875]1041
1042!
[1960]1043!--          Sink or source of scalar concentration due to canopy elements
1044             IF ( plant_canopy )  CALL pcm_tendency( i, j, 7 )
1045
1046!
1047!--          Large scale advection, still need to be extended for scalars
1048!              IF ( large_scale_forcing )  THEN
1049!                 CALL ls_advec( i, j, simulated_time, 's' )
1050!              ENDIF
1051
1052!
1053!--          Nudging, still need to be extended for scalars
[2155]1054!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' )
[1960]1055
1056!
1057!--          If required compute influence of large-scale subsidence/ascent.
[2155]1058!--          Note, the last argument is of no meaning in this case, as it is
1059!--          only used in conjunction with large_scale_forcing, which is to
[1960]1060!--          date not implemented for scalars.
1061             IF ( large_scale_subsidence  .AND.                                &
1062                  .NOT. use_subsidence_tendencies  .AND.                       &
1063                  .NOT. large_scale_forcing )  THEN
1064                CALL subsidence( i, j, tend, s, s_init, 3 )
1065             ENDIF
1066
[3684]1067             CALL module_interface_actions( i, j, 's-tendency' )
[1960]1068
1069!
1070!--          Prognostic equation for scalar
[2232]1071             DO  k = nzb+1, nzt
1072                s_p(k,j,i) = s(k,j,i) + (  dt_3d *                             &
1073                                            ( tsc(2) * tend(k,j,i) +           &
1074                                              tsc(3) * ts_m(k,j,i) )           &
1075                                            - tsc(5) * rdf_sc(k)               &
1076                                                     * ( s(k,j,i) - s_init(k) )&
1077                                        )                                      &
1078                                       * MERGE( 1.0_wp, 0.0_wp,                &
1079                                                BTEST( wall_flags_0(k,j,i), 0 )&
1080                                              )
[1960]1081                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
1082             ENDDO
1083
1084!
1085!--          Calculate tendencies for the next Runge-Kutta step
1086             IF ( timestep_scheme(1:5) == 'runge' )  THEN
1087                IF ( intermediate_timestep_count == 1 )  THEN
[2232]1088                   DO  k = nzb+1, nzt
[1960]1089                      ts_m(k,j,i) = tend(k,j,i)
1090                   ENDDO
1091                ELSEIF ( intermediate_timestep_count < &
1092                         intermediate_timestep_count_max )  THEN
[2232]1093                   DO  k = nzb+1, nzt
1094                      ts_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +               &
1095                                       5.3125_wp * ts_m(k,j,i)
[1960]1096                   ENDDO
1097                ENDIF
1098             ENDIF
1099
[2155]1100          ENDIF
[1960]1101!
[3837]1102!--       Calculate prognostic equations for all other modules
1103          CALL module_interface_prognostic_equations( i, j, i_omp_start, tn )
[1875]1104
[3294]1105       ENDDO  ! loop over j
1106    ENDDO  ! loop over i
[2192]1107    !$OMP END PARALLEL
[1875]1108
[2232]1109
[1875]1110    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
1111
[3987]1112    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'end' )
[1875]1113
1114 END SUBROUTINE prognostic_equations_cache
1115
1116
1117!------------------------------------------------------------------------------!
1118! Description:
1119! ------------
1120!> Version for vector machines
1121!------------------------------------------------------------------------------!
[2155]1122
[1875]1123 SUBROUTINE prognostic_equations_vector
1124
1125
[2815]1126    INTEGER(iwp) ::  i     !<
1127    INTEGER(iwp) ::  j     !<
1128    INTEGER(iwp) ::  k     !<
[1875]1129
1130    REAL(wp)     ::  sbt  !<
1131
[3885]1132
[3987]1133    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'start' )
[3467]1134!
[3931]1135!-- Calculate non advective processes for all other modules
1136    CALL module_interface_non_advective_processes
[1875]1137!
[3931]1138!-- Module Inferface for exchange horiz after non_advective_processes but before
[3956]1139!-- advection. Therefore, non_advective_processes must not run for ghost points.
[3887]1140    CALL module_interface_exchange_horiz()
1141!
[1875]1142!-- u-velocity component
1143    CALL cpu_log( log_point(5), 'u-equation', 'start' )
1144
[3634]1145    !$ACC KERNELS PRESENT(tend)
[1875]1146    tend = 0.0_wp
[3634]1147    !$ACC END KERNELS
[1875]1148    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1149       IF ( ws_scheme_mom )  THEN
1150          CALL advec_u_ws
1151       ELSE
1152          CALL advec_u_pw
1153       ENDIF
1154    ELSE
1155       CALL advec_u_up
1156    ENDIF
1157    CALL diffusion_u
1158    CALL coriolis( 1 )
1159    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
1160       CALL buoyancy( pt, 1 )
1161    ENDIF
1162
1163!
1164!-- Drag by plant canopy
1165    IF ( plant_canopy )  CALL pcm_tendency( 1 )
1166
1167!
1168!-- External pressure gradient
1169    IF ( dp_external )  THEN
1170       DO  i = nxlu, nxr
1171          DO  j = nys, nyn
1172             DO  k = dp_level_ind_b+1, nzt
1173                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
1174             ENDDO
1175          ENDDO
1176       ENDDO
1177    ENDIF
1178
1179!
1180!-- Nudging
1181    IF ( nudging )  CALL nudge( simulated_time, 'u' )
1182
[1914]1183!
[3302]1184!-- Effect of Stokes drift (in ocean mode only)
1185    IF ( stokes_force )  CALL stokes_drift_terms( 1 )
1186
[3684]1187    CALL module_interface_actions( 'u-tendency' )
[1875]1188
1189!
1190!-- Prognostic equation for u-velocity component
[3634]1191    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1192    !$ACC PRESENT(u, tend, tu_m, u_init, rdf, wall_flags_0) &
1193    !$ACC PRESENT(tsc(2:5)) &
1194    !$ACC PRESENT(u_p)
[1875]1195    DO  i = nxlu, nxr
1196       DO  j = nys, nyn
[2232]1197          DO  k = nzb+1, nzt
1198             u_p(k,j,i) = u(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) +          &
1199                                                 tsc(3) * tu_m(k,j,i) )          &
1200                                               - tsc(5) * rdf(k) *               &
1201                                                        ( u(k,j,i) - u_init(k) ) &
1202                                     ) * MERGE( 1.0_wp, 0.0_wp,                  &
1203                                                 BTEST( wall_flags_0(k,j,i), 1 ) &
1204                                              )
[1875]1205          ENDDO
1206       ENDDO
1207    ENDDO
1208
1209!
[3302]1210!-- Add turbulence generated by wave breaking (in ocean mode only)
1211    IF ( wave_breaking  .AND.                                                  &
1212         intermediate_timestep_count == intermediate_timestep_count_max )      &
1213    THEN
1214       CALL wave_breaking_term( 1 )
1215    ENDIF
1216
1217!
[1875]1218!-- Calculate tendencies for the next Runge-Kutta step
1219    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1220       IF ( intermediate_timestep_count == 1 )  THEN
[3634]1221          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1222          !$ACC PRESENT(tend, tu_m)
[1875]1223          DO  i = nxlu, nxr
1224             DO  j = nys, nyn
[2232]1225                DO  k = nzb+1, nzt
[1875]1226                   tu_m(k,j,i) = tend(k,j,i)
1227                ENDDO
1228             ENDDO
1229          ENDDO
1230       ELSEIF ( intermediate_timestep_count < &
1231                intermediate_timestep_count_max )  THEN
[3634]1232          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1233          !$ACC PRESENT(tend, tu_m)
[1875]1234          DO  i = nxlu, nxr
1235             DO  j = nys, nyn
[2232]1236                DO  k = nzb+1, nzt
1237                   tu_m(k,j,i) =    -9.5625_wp * tend(k,j,i)                   &
1238                                   + 5.3125_wp * tu_m(k,j,i)
[1875]1239                ENDDO
1240             ENDDO
1241          ENDDO
1242       ENDIF
1243    ENDIF
1244
1245    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
1246
1247!
1248!-- v-velocity component
1249    CALL cpu_log( log_point(6), 'v-equation', 'start' )
1250
[3634]1251    !$ACC KERNELS PRESENT(tend)
[1875]1252    tend = 0.0_wp
[3634]1253    !$ACC END KERNELS
[1875]1254    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1255       IF ( ws_scheme_mom )  THEN
1256          CALL advec_v_ws
[2155]1257       ELSE
[1875]1258          CALL advec_v_pw
1259       END IF
1260    ELSE
1261       CALL advec_v_up
1262    ENDIF
1263    CALL diffusion_v
1264    CALL coriolis( 2 )
1265
1266!
1267!-- Drag by plant canopy
1268    IF ( plant_canopy )  CALL pcm_tendency( 2 )
1269
1270!
1271!-- External pressure gradient
1272    IF ( dp_external )  THEN
1273       DO  i = nxl, nxr
1274          DO  j = nysv, nyn
1275             DO  k = dp_level_ind_b+1, nzt
1276                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
1277             ENDDO
1278          ENDDO
1279       ENDDO
1280    ENDIF
1281
1282!
1283!-- Nudging
1284    IF ( nudging )  CALL nudge( simulated_time, 'v' )
1285
[1914]1286!
[3302]1287!-- Effect of Stokes drift (in ocean mode only)
1288    IF ( stokes_force )  CALL stokes_drift_terms( 2 )
1289
[3684]1290    CALL module_interface_actions( 'v-tendency' )
[1875]1291
1292!
1293!-- Prognostic equation for v-velocity component
[3634]1294    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1295    !$ACC PRESENT(v, tend, tv_m, v_init, rdf, wall_flags_0) &
1296    !$ACC PRESENT(tsc(2:5)) &
1297    !$ACC PRESENT(v_p)
[1875]1298    DO  i = nxl, nxr
1299       DO  j = nysv, nyn
[2232]1300          DO  k = nzb+1, nzt
1301             v_p(k,j,i) = v(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) +        &
1302                                                 tsc(3) * tv_m(k,j,i) )        &
1303                                               - tsc(5) * rdf(k) *             &
1304                                                      ( v(k,j,i) - v_init(k) ) &
1305                                     ) * MERGE( 1.0_wp, 0.0_wp,                &
1306                                                BTEST( wall_flags_0(k,j,i), 2 )&
1307                                              )
[1875]1308          ENDDO
1309       ENDDO
1310    ENDDO
1311
1312!
[3302]1313!-- Add turbulence generated by wave breaking (in ocean mode only)
1314    IF ( wave_breaking  .AND.                                                  &
1315         intermediate_timestep_count == intermediate_timestep_count_max )      &
1316    THEN
1317       CALL wave_breaking_term( 2 )
1318    ENDIF
1319
1320!
[1875]1321!-- Calculate tendencies for the next Runge-Kutta step
1322    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1323       IF ( intermediate_timestep_count == 1 )  THEN
[3634]1324          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1325          !$ACC PRESENT(tend, tv_m)
[1875]1326          DO  i = nxl, nxr
1327             DO  j = nysv, nyn
[2232]1328                DO  k = nzb+1, nzt
[1875]1329                   tv_m(k,j,i) = tend(k,j,i)
1330                ENDDO
1331             ENDDO
1332          ENDDO
1333       ELSEIF ( intermediate_timestep_count < &
1334                intermediate_timestep_count_max )  THEN
[3634]1335          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1336          !$ACC PRESENT(tend, tv_m)
[1875]1337          DO  i = nxl, nxr
1338             DO  j = nysv, nyn
[2232]1339                DO  k = nzb+1, nzt
1340                   tv_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                    &
1341                                  + 5.3125_wp * tv_m(k,j,i)
[1875]1342                ENDDO
1343             ENDDO
1344          ENDDO
1345       ENDIF
1346    ENDIF
1347
1348    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
1349
1350!
1351!-- w-velocity component
1352    CALL cpu_log( log_point(7), 'w-equation', 'start' )
1353
[3634]1354    !$ACC KERNELS PRESENT(tend)
[1875]1355    tend = 0.0_wp
[3634]1356    !$ACC END KERNELS
[1875]1357    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1358       IF ( ws_scheme_mom )  THEN
1359          CALL advec_w_ws
1360       ELSE
1361          CALL advec_w_pw
1362       ENDIF
1363    ELSE
1364       CALL advec_w_up
1365    ENDIF
1366    CALL diffusion_w
1367    CALL coriolis( 3 )
1368
1369    IF ( .NOT. neutral )  THEN
[3294]1370       IF ( ocean_mode )  THEN
[2031]1371          CALL buoyancy( rho_ocean, 3 )
[1875]1372       ELSE
1373          IF ( .NOT. humidity )  THEN
1374             CALL buoyancy( pt, 3 )
1375          ELSE
1376             CALL buoyancy( vpt, 3 )
1377          ENDIF
1378       ENDIF
1379    ENDIF
1380
1381!
1382!-- Drag by plant canopy
1383    IF ( plant_canopy )  CALL pcm_tendency( 3 )
1384
[1914]1385!
[3302]1386!-- Effect of Stokes drift (in ocean mode only)
1387    IF ( stokes_force )  CALL stokes_drift_terms( 3 )
1388
[3684]1389    CALL module_interface_actions( 'w-tendency' )
[1875]1390
1391!
1392!-- Prognostic equation for w-velocity component
[3634]1393    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1394    !$ACC PRESENT(w, tend, tw_m, v_init, rdf, wall_flags_0) &
1395    !$ACC PRESENT(tsc(2:5)) &
1396    !$ACC PRESENT(w_p)
[1875]1397    DO  i = nxl, nxr
1398       DO  j = nys, nyn
[2232]1399          DO  k = nzb+1, nzt-1
1400             w_p(k,j,i) = w(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) +        &
1401                                                 tsc(3) * tw_m(k,j,i) )        &
1402                                               - tsc(5) * rdf(k) * w(k,j,i)    &
1403                                     ) * MERGE( 1.0_wp, 0.0_wp,                &
1404                                                BTEST( wall_flags_0(k,j,i), 3 )&
1405                                              )
[1875]1406          ENDDO
1407       ENDDO
1408    ENDDO
1409
1410!
1411!-- Calculate tendencies for the next Runge-Kutta step
1412    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1413       IF ( intermediate_timestep_count == 1 )  THEN
[3634]1414          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1415          !$ACC PRESENT(tend, tw_m)
[1875]1416          DO  i = nxl, nxr
1417             DO  j = nys, nyn
[2232]1418                DO  k = nzb+1, nzt-1
[1875]1419                   tw_m(k,j,i) = tend(k,j,i)
1420                ENDDO
1421             ENDDO
1422          ENDDO
1423       ELSEIF ( intermediate_timestep_count < &
1424                intermediate_timestep_count_max )  THEN
[3634]1425          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1426          !$ACC PRESENT(tend, tw_m)
[1875]1427          DO  i = nxl, nxr
1428             DO  j = nys, nyn
[2232]1429                DO  k = nzb+1, nzt-1
1430                   tw_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                    &
1431                                  + 5.3125_wp * tw_m(k,j,i)
[1875]1432                ENDDO
1433             ENDDO
1434          ENDDO
1435       ENDIF
1436    ENDIF
1437
1438    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
1439
1440
1441!
1442!-- If required, compute prognostic equation for potential temperature
1443    IF ( .NOT. neutral )  THEN
1444
1445       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
1446
1447!
1448!--    pt-tendency terms with communication
1449       sbt = tsc(2)
1450       IF ( scalar_advec == 'bc-scheme' )  THEN
1451
1452          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1453!
1454!--          Bott-Chlond scheme always uses Euler time step. Thus:
1455             sbt = 1.0_wp
1456          ENDIF
1457          tend = 0.0_wp
1458          CALL advec_s_bc( pt, 'pt' )
1459
1460       ENDIF
1461
1462!
1463!--    pt-tendency terms with no communication
1464       IF ( scalar_advec /= 'bc-scheme' )  THEN
[3634]1465          !$ACC KERNELS PRESENT(tend)
[1875]1466          tend = 0.0_wp
[3634]1467          !$ACC END KERNELS
[1875]1468          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1469             IF ( ws_scheme_sca )  THEN
[4109]1470                CALL advec_s_ws( advc_flags_s, pt, 'pt',                       &
1471                                 bc_dirichlet_l  .OR.  bc_radiation_l,         &
1472                                 bc_dirichlet_n  .OR.  bc_radiation_n,         &
1473                                 bc_dirichlet_r  .OR.  bc_radiation_r,         &
1474                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]1475             ELSE
1476                CALL advec_s_pw( pt )
1477             ENDIF
1478          ELSE
1479             CALL advec_s_up( pt )
1480          ENDIF
1481       ENDIF
1482
[2232]1483       CALL diffusion_s( pt,                                                   &
1484                         surf_def_h(0)%shf, surf_def_h(1)%shf,                 &
1485                         surf_def_h(2)%shf,                                    &
1486                         surf_lsm_h%shf,    surf_usm_h%shf,                    &
1487                         surf_def_v(0)%shf, surf_def_v(1)%shf,                 &
1488                         surf_def_v(2)%shf, surf_def_v(3)%shf,                 &
1489                         surf_lsm_v(0)%shf, surf_lsm_v(1)%shf,                 &
1490                         surf_lsm_v(2)%shf, surf_lsm_v(3)%shf,                 &
1491                         surf_usm_v(0)%shf, surf_usm_v(1)%shf,                 &
1492                         surf_usm_v(2)%shf, surf_usm_v(3)%shf )
[1875]1493
1494!
1495!--    Consideration of heat sources within the plant canopy
[3014]1496       IF ( plant_canopy  .AND.                                          &
1497            (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  THEN
[1875]1498          CALL pcm_tendency( 4 )
1499       ENDIF
1500
1501!
1502!--    Large scale advection
1503       IF ( large_scale_forcing )  THEN
1504          CALL ls_advec( simulated_time, 'pt' )
1505       ENDIF
1506
1507!
1508!--    Nudging
[2155]1509       IF ( nudging )  CALL nudge( simulated_time, 'pt' )
[1875]1510
1511!
1512!--    If required compute influence of large-scale subsidence/ascent
1513       IF ( large_scale_subsidence  .AND.                                      &
1514            .NOT. use_subsidence_tendencies )  THEN
1515          CALL subsidence( tend, pt, pt_init, 2 )
1516       ENDIF
1517
[3771]1518#if defined( __rrtmg )
[1875]1519!
1520!--    If required, add tendency due to radiative heating/cooling
[1976]1521       IF ( radiation  .AND.                                                   &
[1875]1522            simulated_time > skip_time_do_radiation )  THEN
1523            CALL radiation_tendency ( tend )
1524       ENDIF
[3771]1525#endif
[1875]1526
[3684]1527       CALL module_interface_actions( 'pt-tendency' )
[1875]1528
1529!
1530!--    Prognostic equation for potential temperature
[3634]1531       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1532       !$ACC PRESENT(pt, tend, tpt_m, wall_flags_0) &
1533       !$ACC PRESENT(pt_init, rdf_sc, ptdf_x, ptdf_y) &
1534       !$ACC PRESENT(tsc(3:5)) &
1535       !$ACC PRESENT(pt_p)
[1875]1536       DO  i = nxl, nxr
1537          DO  j = nys, nyn
[2232]1538             DO  k = nzb+1, nzt
1539                pt_p(k,j,i) = pt(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +      &
1540                                                   tsc(3) * tpt_m(k,j,i) )     &
1541                                                 - tsc(5) *                    &
1542                                                   ( pt(k,j,i) - pt_init(k) ) *&
1543                                          ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) )&
1544                                          )                                    &
1545                                   * MERGE( 1.0_wp, 0.0_wp,                    &
1546                                             BTEST( wall_flags_0(k,j,i), 0 )   &
1547                                          )
[1875]1548             ENDDO
1549          ENDDO
1550       ENDDO
1551!
1552!--    Calculate tendencies for the next Runge-Kutta step
1553       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1554          IF ( intermediate_timestep_count == 1 )  THEN
[3634]1555             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1556             !$ACC PRESENT(tend, tpt_m)
[1875]1557             DO  i = nxl, nxr
1558                DO  j = nys, nyn
[2232]1559                   DO  k = nzb+1, nzt
[1875]1560                      tpt_m(k,j,i) = tend(k,j,i)
1561                   ENDDO
1562                ENDDO
1563             ENDDO
1564          ELSEIF ( intermediate_timestep_count < &
1565                   intermediate_timestep_count_max )  THEN
[3634]1566             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1567             !$ACC PRESENT(tend, tpt_m)
[1875]1568             DO  i = nxl, nxr
1569                DO  j = nys, nyn
[2232]1570                   DO  k = nzb+1, nzt
1571                      tpt_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +              &
1572                                        5.3125_wp * tpt_m(k,j,i)
[1875]1573                   ENDDO
1574                ENDDO
1575             ENDDO
1576          ENDIF
1577       ENDIF
1578
1579       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
1580
1581    ENDIF
1582
1583!
[1960]1584!-- If required, compute prognostic equation for total water content
1585    IF ( humidity )  THEN
[1875]1586
[1960]1587       CALL cpu_log( log_point(29), 'q-equation', 'start' )
[1875]1588
1589!
1590!--    Scalar/q-tendency terms with communication
1591       sbt = tsc(2)
1592       IF ( scalar_advec == 'bc-scheme' )  THEN
1593
1594          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1595!
1596!--          Bott-Chlond scheme always uses Euler time step. Thus:
1597             sbt = 1.0_wp
1598          ENDIF
1599          tend = 0.0_wp
1600          CALL advec_s_bc( q, 'q' )
1601
1602       ENDIF
1603
1604!
1605!--    Scalar/q-tendency terms with no communication
1606       IF ( scalar_advec /= 'bc-scheme' )  THEN
1607          tend = 0.0_wp
1608          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1609             IF ( ws_scheme_sca )  THEN
[4109]1610                CALL advec_s_ws( advc_flags_s, q, 'q',                         &
1611                                 bc_dirichlet_l  .OR.  bc_radiation_l,         &
1612                                 bc_dirichlet_n  .OR.  bc_radiation_n,         &
1613                                 bc_dirichlet_r  .OR.  bc_radiation_r,         &
1614                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]1615             ELSE
1616                CALL advec_s_pw( q )
1617             ENDIF
1618          ELSE
1619             CALL advec_s_up( q )
1620          ENDIF
1621       ENDIF
1622
[2232]1623       CALL diffusion_s( q,                                                    &
1624                         surf_def_h(0)%qsws, surf_def_h(1)%qsws,               &
1625                         surf_def_h(2)%qsws,                                   &
1626                         surf_lsm_h%qsws,    surf_usm_h%qsws,                  &
1627                         surf_def_v(0)%qsws, surf_def_v(1)%qsws,               &
1628                         surf_def_v(2)%qsws, surf_def_v(3)%qsws,               &
1629                         surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws,               &
1630                         surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws,               &
1631                         surf_usm_v(0)%qsws, surf_usm_v(1)%qsws,               &
1632                         surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
[2155]1633
[1875]1634!
[1960]1635!--    Sink or source of humidity due to canopy elements
[1875]1636       IF ( plant_canopy ) CALL pcm_tendency( 5 )
1637
1638!
1639!--    Large scale advection
1640       IF ( large_scale_forcing )  THEN
1641          CALL ls_advec( simulated_time, 'q' )
1642       ENDIF
1643
1644!
1645!--    Nudging
[2155]1646       IF ( nudging )  CALL nudge( simulated_time, 'q' )
[1875]1647
1648!
1649!--    If required compute influence of large-scale subsidence/ascent
1650       IF ( large_scale_subsidence  .AND.                                      &
1651            .NOT. use_subsidence_tendencies )  THEN
1652         CALL subsidence( tend, q, q_init, 3 )
1653       ENDIF
1654
[3684]1655       CALL module_interface_actions( 'q-tendency' )
[1875]1656
1657!
[1960]1658!--    Prognostic equation for total water content
[1875]1659       DO  i = nxl, nxr
1660          DO  j = nys, nyn
[2232]1661             DO  k = nzb+1, nzt
1662                q_p(k,j,i) = q(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +        &
1663                                                 tsc(3) * tq_m(k,j,i) )        &
1664                                               - tsc(5) * rdf_sc(k) *          &
1665                                                      ( q(k,j,i) - q_init(k) ) &
1666                                        ) * MERGE( 1.0_wp, 0.0_wp,             &
1667                                                   BTEST( wall_flags_0(k,j,i), 0 ) &
1668                                                 )
[1875]1669                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
1670             ENDDO
1671          ENDDO
1672       ENDDO
1673
1674!
1675!--    Calculate tendencies for the next Runge-Kutta step
1676       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1677          IF ( intermediate_timestep_count == 1 )  THEN
1678             DO  i = nxl, nxr
1679                DO  j = nys, nyn
[2232]1680                   DO  k = nzb+1, nzt
[1875]1681                      tq_m(k,j,i) = tend(k,j,i)
1682                   ENDDO
1683                ENDDO
1684             ENDDO
1685          ELSEIF ( intermediate_timestep_count < &
1686                   intermediate_timestep_count_max )  THEN
1687             DO  i = nxl, nxr
1688                DO  j = nys, nyn
[2232]1689                   DO  k = nzb+1, nzt
1690                      tq_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                 &
1691                                     + 5.3125_wp * tq_m(k,j,i)
[1875]1692                   ENDDO
1693                ENDDO
1694             ENDDO
1695          ENDIF
1696       ENDIF
1697
[1960]1698       CALL cpu_log( log_point(29), 'q-equation', 'stop' )
[1875]1699
1700    ENDIF
[1960]1701!
1702!-- If required, compute prognostic equation for scalar
1703    IF ( passive_scalar )  THEN
[1875]1704
[1960]1705       CALL cpu_log( log_point(66), 's-equation', 'start' )
1706
[1875]1707!
[1960]1708!--    Scalar/q-tendency terms with communication
1709       sbt = tsc(2)
1710       IF ( scalar_advec == 'bc-scheme' )  THEN
1711
1712          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1713!
1714!--          Bott-Chlond scheme always uses Euler time step. Thus:
1715             sbt = 1.0_wp
1716          ENDIF
1717          tend = 0.0_wp
1718          CALL advec_s_bc( s, 's' )
1719
1720       ENDIF
1721
1722!
1723!--    Scalar/q-tendency terms with no communication
1724       IF ( scalar_advec /= 'bc-scheme' )  THEN
1725          tend = 0.0_wp
1726          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1727             IF ( ws_scheme_sca )  THEN
[4109]1728                CALL advec_s_ws( advc_flags_s, s, 's',                         &
1729                                 bc_dirichlet_l  .OR.  bc_radiation_l,         &
1730                                 bc_dirichlet_n  .OR.  bc_radiation_n,         &
1731                                 bc_dirichlet_r  .OR.  bc_radiation_r,         &
1732                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1960]1733             ELSE
1734                CALL advec_s_pw( s )
1735             ENDIF
1736          ELSE
1737             CALL advec_s_up( s )
1738          ENDIF
1739       ENDIF
1740
[2232]1741       CALL diffusion_s( s,                                                    &
1742                         surf_def_h(0)%ssws, surf_def_h(1)%ssws,               &
1743                         surf_def_h(2)%ssws,                                   &
1744                         surf_lsm_h%ssws,    surf_usm_h%ssws,                  &
1745                         surf_def_v(0)%ssws, surf_def_v(1)%ssws,               &
1746                         surf_def_v(2)%ssws, surf_def_v(3)%ssws,               &
1747                         surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws,               &
1748                         surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws,               &
1749                         surf_usm_v(0)%ssws, surf_usm_v(1)%ssws,               &
1750                         surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
[2155]1751
[1960]1752!
1753!--    Sink or source of humidity due to canopy elements
1754       IF ( plant_canopy ) CALL pcm_tendency( 7 )
1755
1756!
1757!--    Large scale advection. Not implemented for scalars so far.
1758!        IF ( large_scale_forcing )  THEN
1759!           CALL ls_advec( simulated_time, 'q' )
1760!        ENDIF
1761
1762!
1763!--    Nudging. Not implemented for scalars so far.
[2155]1764!        IF ( nudging )  CALL nudge( simulated_time, 'q' )
[1960]1765
1766!
1767!--    If required compute influence of large-scale subsidence/ascent.
1768!--    Not implemented for scalars so far.
1769       IF ( large_scale_subsidence  .AND.                                      &
1770            .NOT. use_subsidence_tendencies  .AND.                             &
1771            .NOT. large_scale_forcing )  THEN
1772         CALL subsidence( tend, s, s_init, 3 )
1773       ENDIF
1774
[3684]1775       CALL module_interface_actions( 's-tendency' )
[1960]1776
1777!
1778!--    Prognostic equation for total water content
1779       DO  i = nxl, nxr
1780          DO  j = nys, nyn
[2232]1781             DO  k = nzb+1, nzt
1782                s_p(k,j,i) = s(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) +        &
1783                                                 tsc(3) * ts_m(k,j,i) )        &
1784                                               - tsc(5) * rdf_sc(k) *          &
1785                                                    ( s(k,j,i) - s_init(k) )   &
1786                                        )                                      &
1787                                   * MERGE( 1.0_wp, 0.0_wp,                    &
1788                                             BTEST( wall_flags_0(k,j,i), 0 )   &
1789                                          )
[1960]1790                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
1791             ENDDO
1792          ENDDO
1793       ENDDO
1794
1795!
1796!--    Calculate tendencies for the next Runge-Kutta step
1797       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1798          IF ( intermediate_timestep_count == 1 )  THEN
1799             DO  i = nxl, nxr
1800                DO  j = nys, nyn
[2232]1801                   DO  k = nzb+1, nzt
[1960]1802                      ts_m(k,j,i) = tend(k,j,i)
1803                   ENDDO
1804                ENDDO
1805             ENDDO
1806          ELSEIF ( intermediate_timestep_count < &
1807                   intermediate_timestep_count_max )  THEN
1808             DO  i = nxl, nxr
1809                DO  j = nys, nyn
[2232]1810                   DO  k = nzb+1, nzt
1811                      ts_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                 &
1812                                     + 5.3125_wp * ts_m(k,j,i)
[1960]1813                   ENDDO
1814                ENDDO
1815             ENDDO
1816          ENDIF
1817       ENDIF
1818
1819       CALL cpu_log( log_point(66), 's-equation', 'stop' )
1820
1821    ENDIF
[3294]1822!
[3837]1823!-- Calculate prognostic equations for all other modules
1824    CALL module_interface_prognostic_equations()
[1875]1825
[3987]1826    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'end' )
[3885]1827
[1875]1828 END SUBROUTINE prognostic_equations_vector
1829
1830
1831 END MODULE prognostic_equations_mod
Note: See TracBrowser for help on using the repository browser.