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

Last change on this file since 3880 was 3880, checked in by knoop, 5 years ago

Moved chem_prognostic_equations into module_interface

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