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

Last change on this file since 1727 was 1692, checked in by maronga, 9 years ago

last commit documented

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