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

Last change on this file since 4692 was 4671, checked in by pavelkrc, 4 years ago

Radiative transfer model RTM version 4.1

  • Property svn:keywords set to Id
File size: 65.7 KB
RevLine 
[1873]1!> @file prognostic_equations.f90
[4649]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1875]4!
[4649]5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
[1875]8!
[4649]9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
[1875]12!
[4649]13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
[1875]15!
[4360]16! Copyright 1997-2020 Leibniz Universitaet Hannover
[4649]17!--------------------------------------------------------------------------------------------------!
[1875]18!
[4649]19!
[1875]20! Current revisions:
[4649]21! -----------------
22!
23!
[4110]24! Former revisions:
25! -----------------
26! $Id: prognostic_equations.f90 4671 2020-09-09 20:27:58Z maronga $
[4671]27! Implementation of downward facing USM and LSM surfaces
28!
29! 4649 2020-08-25 12:11:17Z raasch
[4649]30! File re-formatted to follow the PALM coding standard
31!
32!
33! 4370 2020-01-10 14:00:44Z raasch
34! Vector directives added to force vectorization on Intel19 compiler
35!
[4370]36! 4360 2020-01-07 11:25:50Z suehring
[4649]37! Introduction of wall_flags_total_0, which currently sets bits based on static topography
38! information used in wall_flags_static_0
39!
[4346]40! 4329 2019-12-10 15:46:36Z motisi
[4329]41! Renamed wall_flags_0 to wall_flags_static_0
[4649]42!
[4329]43! 4182 2019-08-22 15:20:23Z scharf
[4182]44! Corrected "Former revisions" section
[4649]45!
[4182]46! 4110 2019-07-22 17:05:21Z suehring
[4649]47! Pass integer flag array to WS scalar advection routine which is now necessary as the flags may
48! differ for scalars, e.g. pt can be cyclic while chemical species may be non-cyclic. Further,
49! pass boundary flags.
50!
[4110]51! 4109 2019-07-22 17:00:34Z suehring
[4649]52! Application of monotonic flux limiter for the vertical scalar advection up to the topography top
53! (only for the cache-optimized version at the moment). Please note, at the moment the limiter is
54! only applied for passive scalars.
55!
[4079]56! 4048 2019-06-21 21:00:21Z knoop
[4048]57! Moved tcm_prognostic_equations to module_interface
[4649]58!
[4048]59! 3987 2019-05-22 09:52:13Z kanani
[3987]60! Introduce alternative switch for debug output during timestepping
[4649]61!
[3987]62! 3956 2019-05-07 12:32:52Z monakurppa
[3956]63! Removed salsa calls.
[4649]64!
[3956]65! 3931 2019-04-24 16:34:28Z schwenkel
[3929]66! Correct/complete module_interface introduction for chemistry model
[4649]67!
[3929]68! 3899 2019-04-16 14:05:27Z monakurppa
[3899]69! Corrections in the OpenMP version of salsa
[3929]70!
71! 3887 2019 -04-12 08:47:41Z schwenkel
[4649]72! Implicit Bugfix for chemistry model, loop for non_transport_physics over ghost points is avoided.
73! Instead introducing module_interface_exchange_horiz.
74!
[3887]75! 3885 2019-04-11 11:29:34Z kanani
[4649]76! Changes related to global restructuring of location messages and introduction of additional debug
77! messages
78!
[3885]79! 3881 2019-04-10 09:31:22Z suehring
[3881]80! Bugfix in OpenMP directive
[4649]81!
[3881]82! 3880 2019-04-08 21:43:02Z knoop
[3875]83! Moved wtm_tendencies to module_interface_actions
[4649]84!
[3875]85! 3874 2019-04-08 16:53:48Z knoop
[3874]86! Added non_transport_physics module interfaces and moved bcm code into it
[4649]87!
[3874]88! 3872 2019-04-08 15:03:06Z knoop
[3870]89! Moving prognostic equations of bcm into bulk_cloud_model_mod
[4649]90!
[3870]91! 3864 2019-04-05 09:01:56Z monakurppa
[3864]92! Modifications made for salsa:
[4649]93! - salsa_prognostic_equations moved to salsa_mod (and the call to module_interface_mod)
94! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> ngases_salsa and
95!   loop indices b, c and sg to ib, ic and ig
96!
[3864]97! 3840 2019-03-29 10:35:52Z knoop
[4649]98! Added USE chem_gasphase_mod for nspec, nspec and spc_names
99!
[3833]100! 3820 2019-03-27 11:53:41Z forkel
[4649]101! Renamed do_depo to deposition_dry (ecc)
102!
[3820]103! 3797 2019-03-15 11:15:38Z forkel
[4649]104! Call chem_integegrate in OpenMP loop (ketelsen)
105!
106!
[3797]107! 3771 2019-02-28 12:19:33Z raasch
[4649]108! Preprocessor directivs fro rrtmg added
109!
[3771]110! 3761 2019-02-25 15:31:42Z raasch
[4649]111! Unused variable removed
112!
[3761]113! 3719 2019-02-06 13:10:18Z kanani
[3719]114! Cleaned up chemistry cpu measurements
[4649]115!
[3719]116! 3684 2019-01-20 20:20:58Z knoop
[3634]117! OpenACC port for SPEC
[3458]118!
[4182]119! Revision 1.1  2000/04/13 14:56:27  schroeter
120! Initial revision
121!
[4649]122!--------------------------------------------------------------------------------------------------!
[1875]123! Description:
124! ------------
125!> Solving the prognostic equations.
[4649]126!--------------------------------------------------------------------------------------------------!
[1875]127 MODULE prognostic_equations_mod
128
[4649]129    USE advec_s_bc_mod,                                                                            &
[3294]130        ONLY:  advec_s_bc
[2155]131
[4649]132    USE advec_s_pw_mod,                                                                            &
[3294]133        ONLY:  advec_s_pw
134
[4649]135    USE advec_s_up_mod,                                                                            &
[3294]136        ONLY:  advec_s_up
137
[4649]138    USE advec_u_pw_mod,                                                                            &
[3294]139        ONLY:  advec_u_pw
140
[4649]141    USE advec_u_up_mod,                                                                            &
[3294]142        ONLY:  advec_u_up
143
[4649]144    USE advec_v_pw_mod,                                                                            &
[3294]145        ONLY:  advec_v_pw
146
[4649]147    USE advec_v_up_mod,                                                                            &
[3294]148        ONLY:  advec_v_up
149
[4649]150    USE advec_w_pw_mod,                                                                            &
[3294]151        ONLY:  advec_w_pw
152
[4649]153    USE advec_w_up_mod,                                                                            &
[3294]154        ONLY:  advec_w_up
155
[4649]156    USE advec_ws,                                                                                  &
157        ONLY:  advec_s_ws,                                                                         &
158               advec_u_ws,                                                                         &
159               advec_v_ws,                                                                         &
160               advec_w_ws
[3294]161
[4649]162    USE arrays_3d,                                                                                 &
163        ONLY:  diss_l_e,                                                                           &
164               diss_l_pt,                                                                          &
165               diss_l_q,                                                                           &
166               diss_l_s,                                                                           &
167               diss_l_sa,                                                                          &
168               diss_s_e,                                                                           &
169               diss_s_pt,                                                                          &
170               diss_s_q,                                                                           &
171               diss_s_s,                                                                           &
172               diss_s_sa,                                                                          &
173               e,                                                                                  &
174               e_p,                                                                                &
175               flux_s_e,                                                                           &
176               flux_s_pt,                                                                          &
177               flux_s_q,                                                                           &
178               flux_s_s,                                                                           &
179               flux_s_sa,                                                                          &
180               flux_l_e,                                                                           &
181               flux_l_pt,                                                                          &
182               flux_l_q,                                                                           &
183               flux_l_s,                                                                           &
184               flux_l_sa,                                                                          &
185               pt,                                                                                 &
186               ptdf_x,                                                                             &
187               ptdf_y,                                                                             &
188               pt_init,                                                                            &
189               pt_p,                                                                               &
190               prho,                                                                               &
191               q,                                                                                  &
192               q_init,                                                                             &
193               q_p,                                                                                &
194               rdf,                                                                                &
195               rdf_sc,                                                                             &
196               ref_state,                                                                          &
197               rho_ocean,                                                                          &
198               s,                                                                                  &
199               s_init,                                                                             &
200               s_p,                                                                                &
201               tend,                                                                               &
202               te_m,                                                                               &
203               tpt_m,                                                                              &
204               tq_m,                                                                               &
205               ts_m,                                                                               &
206               tu_m,                                                                               &
207               tv_m,                                                                               &
208               tw_m,                                                                               &
209               u,                                                                                  &
210               ug,                                                                                 &
211               u_init,                                                                             &
212               u_p,                                                                                &
213               v,                                                                                  &
214               vg,                                                                                 &
215               vpt,                                                                                &
216               v_init,                                                                             &
217               v_p,                                                                                &
218               w,                                                                                  &
219               w_p
[2155]220
[4649]221    USE buoyancy_mod,                                                                              &
[3294]222        ONLY:  buoyancy
[3864]223
[4649]224    USE control_parameters,                                                                        &
225        ONLY:  bc_dirichlet_l,                                                                     &
226               bc_dirichlet_n,                                                                     &
227               bc_dirichlet_r,                                                                     &
228               bc_dirichlet_s,                                                                     &
229               bc_radiation_l,                                                                     &
230               bc_radiation_n,                                                                     &
231               bc_radiation_r,                                                                     &
232               bc_radiation_s,                                                                     &
233               constant_diffusion,                                                                 &
234               debug_output_timestep,                                                              &
235               dp_external,                                                                        &
236               dp_level_ind_b,                                                                     &
237               dp_smooth_factor,                                                                   &
238               dpdxy,                                                                              &
239               dt_3d,                                                                              &
240               humidity,                                                                           &
241               intermediate_timestep_count,                                                        &
242               intermediate_timestep_count_max,                                                    &
243               land_surface,                                                                       &
244               large_scale_forcing,                                                                &
245               large_scale_subsidence,                                                             &
246               monotonic_limiter_z,                                                                &
247               neutral,                                                                            &
248               nudging,                                                                            &
249               ocean_mode,                                                                         &
250               passive_scalar,                                                                     &
251               plant_canopy,                                                                       &
252               pt_reference,                                                                       &
253               salsa,                                                                              &
254               scalar_advec,                                                                       &
255               scalar_advec,                                                                       &
256               simulated_time,                                                                     &
257               sloping_surface,                                                                    &
258               time_since_reference_point,                                                         &
259               timestep_scheme,                                                                    &
260               tsc,                                                                                &
261               urban_surface,                                                                      &
262               use_subsidence_tendencies,                                                          &
263               use_upstream_for_tke,                                                               &
264               wind_turbine,                                                                       &
265               ws_scheme_mom,                                                                      &
266               ws_scheme_sca
[1875]267
[4649]268
269
270
271
272    USE coriolis_mod,                                                                              &
[3294]273        ONLY:  coriolis
274
[4649]275    USE cpulog,                                                                                    &
276        ONLY:  cpu_log,                                                                            &
277               log_point,                                                                          &
278               log_point_s
[1875]279
[4649]280    USE diffusion_s_mod,                                                                           &
[2118]281        ONLY:  diffusion_s
[1875]282
[4649]283    USE diffusion_u_mod,                                                                           &
[2118]284        ONLY:  diffusion_u
[1875]285
[4649]286    USE diffusion_v_mod,                                                                           &
[2118]287        ONLY:  diffusion_v
[1875]288
[4649]289    USE diffusion_w_mod,                                                                           &
[2118]290        ONLY:  diffusion_w
[1875]291
[4649]292    USE indices,                                                                                   &
293        ONLY:  advc_flags_s,                                                                       &
294               nbgp,                                                                               &
295               nxl,                                                                                &
296               nxlg,                                                                               &
297               nxlu,                                                                               &
298               nxr,                                                                                &
299               nxrg,                                                                               &
300               nyn,                                                                                &
301               nyng,                                                                               &
302               nys,                                                                                &
303               nysg,                                                                               &
304               nysv,                                                                               &
305               nzb,                                                                                &
306               nzt,                                                                                &
307               wall_flags_total_0
[3294]308
[1875]309    USE kinds
310
[4649]311    USE lsf_nudging_mod,                                                                           &
312        ONLY:  ls_advec,                                                                           &
313               nudge
[1875]314
[4649]315    USE module_interface,                                                                          &
316        ONLY:  module_interface_actions,                                                           &
317               module_interface_exchange_horiz,                                                    &
318               module_interface_non_advective_processes,                                           &
[3837]319               module_interface_prognostic_equations
[3684]320
[4649]321    USE ocean_mod,                                                                                 &
322        ONLY:  stokes_drift_terms,                                                                 &
323               stokes_force,                                                                       &
324               wave_breaking,                                                                      &
325               wave_breaking_term
[3294]326
[4649]327    USE plant_canopy_model_mod,                                                                    &
328        ONLY:  cthf,                                                                               &
329               pcm_tendency
[1875]330
[3771]331#if defined( __rrtmg )
[4649]332    USE radiation_model_mod,                                                                       &
333        ONLY:  radiation,                                                                          &
334               radiation_tendency,                                                                 &
[1875]335               skip_time_do_radiation
[3771]336#endif
[3864]337
[4649]338    USE statistics,                                                                                &
[1875]339        ONLY:  hom
340
[4649]341    USE subsidence_mod,                                                                            &
[1875]342        ONLY:  subsidence
343
[4649]344    USE surface_mod,                                                                               &
345        ONLY :  surf_def_h,                                                                        &
346                surf_def_v,                                                                        &
347                surf_lsm_h,                                                                        &
348                surf_lsm_v,                                                                        &
349                surf_usm_h,                                                                        &
[3294]350                surf_usm_v
351
[3874]352    IMPLICIT NONE
[1914]353
[1875]354    PRIVATE
[2118]355    PUBLIC prognostic_equations_cache, prognostic_equations_vector
[1875]356
357    INTERFACE prognostic_equations_cache
358       MODULE PROCEDURE prognostic_equations_cache
359    END INTERFACE prognostic_equations_cache
360
361    INTERFACE prognostic_equations_vector
362       MODULE PROCEDURE prognostic_equations_vector
363    END INTERFACE prognostic_equations_vector
364
365
366 CONTAINS
367
368
[4649]369!--------------------------------------------------------------------------------------------------!
[1875]370! Description:
371! ------------
[4649]372!> Version with one optimized loop over all equations. It is only allowed to be called for the
373!> Wicker and Skamarock or Piascek-Williams advection scheme.
[1875]374!>
[4649]375!> Here the calls of most subroutines are embedded in two DO loops over i and j, so communication
376!> between CPUs is not allowed (does not make sense) within these loops.
[1875]377!>
378!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
[4649]379!--------------------------------------------------------------------------------------------------!
[2155]380
[1875]381 SUBROUTINE prognostic_equations_cache
382
383
384    INTEGER(iwp) ::  i                   !<
385    INTEGER(iwp) ::  i_omp_start         !<
386    INTEGER(iwp) ::  j                   !<
387    INTEGER(iwp) ::  k                   !<
[3241]388!$  INTEGER(iwp) ::  omp_get_thread_num  !<
[1875]389    INTEGER(iwp) ::  tn = 0              !<
[2155]390
[1875]391    LOGICAL      ::  loop_start          !<
392
393
[3987]394    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'start' )
[1875]395!
396!-- Time measurement can only be performed for the whole set of equations
397    CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
398
[3878]399    !$OMP PARALLEL PRIVATE (i,j)
400    !$OMP DO
[3887]401    DO  i = nxl, nxr
402       DO  j = nys, nyn
[1875]403!
[3931]404!--       Calculate non advective processes for all other modules
405          CALL module_interface_non_advective_processes( i, j )
[3878]406       ENDDO
407    ENDDO
[3887]408!
[4649]409!-- Module Inferface for exchange horiz after non_advective_processes but before advection.
410!-- Therefore, non_advective_processes must not run for ghost points.
[3956]411    !$OMP END PARALLEL
[3887]412    CALL module_interface_exchange_horiz()
[2696]413!
[2192]414!-- Loop over all prognostic equations
[3881]415    !$OMP PARALLEL PRIVATE (i,i_omp_start,j,k,loop_start,tn)
[2192]416
417    !$  tn = omp_get_thread_num()
418    loop_start = .TRUE.
419
420    !$OMP DO
[1875]421    DO  i = nxl, nxr
422
423!
[4649]424!--    Store the first loop index. It differs for each thread and is required later in advec_ws
[1875]425       IF ( loop_start )  THEN
426          loop_start  = .FALSE.
[2155]427          i_omp_start = i
[1875]428       ENDIF
429
430       DO  j = nys, nyn
431!
[4649]432!--       Tendency terms for u-velocity component. Please note, in case of non-cyclic boundary
433!--       conditions the grid point i=0 is excluded from the prognostic equations for the
434!--       u-component.
[3022]435          IF ( i >= nxlu )  THEN
[1875]436
437             tend(:,j,i) = 0.0_wp
438             IF ( timestep_scheme(1:5) == 'runge' )  THEN
439                IF ( ws_scheme_mom )  THEN
440                   CALL advec_u_ws( i, j, i_omp_start, tn )
[2155]441                ELSE
[1875]442                   CALL advec_u_pw( i, j )
[2155]443                ENDIF
[1875]444             ELSE
445                CALL advec_u_up( i, j )
446             ENDIF
447             CALL diffusion_u( i, j )
448             CALL coriolis( i, j, 1 )
449             IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
450                CALL buoyancy( i, j, pt, 1 )
451             ENDIF
452
453!
454!--          Drag by plant canopy
455             IF ( plant_canopy )  CALL pcm_tendency( i, j, 1 )
456
457!
458!--          External pressure gradient
459             IF ( dp_external )  THEN
460                DO  k = dp_level_ind_b+1, nzt
461                   tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
462                ENDDO
463             ENDIF
464
465!
466!--          Nudging
467             IF ( nudging )  CALL nudge( i, j, simulated_time, 'u' )
468
[1914]469!
[3302]470!--          Effect of Stokes drift (in ocean mode only)
471             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 1 )
472
[3684]473             CALL module_interface_actions( i, j, 'u-tendency' )
[1875]474!
475!--          Prognostic equation for u-velocity component
[2232]476             DO  k = nzb+1, nzt
477
[4649]478                u_p(k,j,i) = u(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) )  &
479                                          - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) ) )           &
480                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
[1875]481             ENDDO
482
483!
[3302]484!--          Add turbulence generated by wave breaking (in ocean mode only)
[4649]485             IF ( wave_breaking  .AND.                                                             &
486                  intermediate_timestep_count == intermediate_timestep_count_max )  THEN
[3302]487                CALL wave_breaking_term( i, j, 1 )
488             ENDIF
489
490!
[1875]491!--          Calculate tendencies for the next Runge-Kutta step
492             IF ( timestep_scheme(1:5) == 'runge' )  THEN
493                IF ( intermediate_timestep_count == 1 )  THEN
[2232]494                   DO  k = nzb+1, nzt
[1875]495                      tu_m(k,j,i) = tend(k,j,i)
496                   ENDDO
[4649]497                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[2232]498                   DO  k = nzb+1, nzt
[4649]499                      tu_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
[1875]500                   ENDDO
501                ENDIF
502             ENDIF
503
504          ENDIF
505!
[4649]506!--       Tendency terms for v-velocity component. Please note, in case of non-cyclic boundary
507!--       conditions the grid point j=0 is excluded from the prognostic equations for the
508!--       v-component.
[3022]509          IF ( j >= nysv )  THEN
[1875]510
511             tend(:,j,i) = 0.0_wp
512             IF ( timestep_scheme(1:5) == 'runge' )  THEN
513                IF ( ws_scheme_mom )  THEN
514                    CALL advec_v_ws( i, j, i_omp_start, tn )
[2155]515                ELSE
[1875]516                    CALL advec_v_pw( i, j )
517                ENDIF
518             ELSE
519                CALL advec_v_up( i, j )
520             ENDIF
521             CALL diffusion_v( i, j )
522             CALL coriolis( i, j, 2 )
523
524!
525!--          Drag by plant canopy
[2155]526             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )
[1875]527
528!
529!--          External pressure gradient
530             IF ( dp_external )  THEN
531                DO  k = dp_level_ind_b+1, nzt
532                   tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
533                ENDDO
534             ENDIF
535
536!
537!--          Nudging
538             IF ( nudging )  CALL nudge( i, j, simulated_time, 'v' )
539
[1914]540!
[3302]541!--          Effect of Stokes drift (in ocean mode only)
542             IF ( stokes_force )  CALL stokes_drift_terms( i, j, 2 )
543
[3684]544             CALL module_interface_actions( i, j, 'v-tendency' )
[1875]545!
546!--          Prognostic equation for v-velocity component
[2232]547             DO  k = nzb+1, nzt
[4649]548                v_p(k,j,i) = v(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) )  &
549                                          - tsc(5) * rdf(k) * ( v(k,j,i) - v_init(k) ) )           &
550                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
[1875]551             ENDDO
552
553!
[3302]554!--          Add turbulence generated by wave breaking (in ocean mode only)
[4649]555             IF ( wave_breaking  .AND.                                                             &
556                  intermediate_timestep_count == intermediate_timestep_count_max )  THEN
[3302]557                CALL wave_breaking_term( i, j, 2 )
558             ENDIF
559
560!
[1875]561!--          Calculate tendencies for the next Runge-Kutta step
562             IF ( timestep_scheme(1:5) == 'runge' )  THEN
563                IF ( intermediate_timestep_count == 1 )  THEN
[2232]564                   DO  k = nzb+1, nzt
[1875]565                      tv_m(k,j,i) = tend(k,j,i)
566                   ENDDO
[4649]567                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[2232]568                   DO  k = nzb+1, nzt
[4649]569                      tv_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
[1875]570                   ENDDO
571                ENDIF
572             ENDIF
573
574          ENDIF
575
576!
577!--       Tendency terms for w-velocity component
578          tend(:,j,i) = 0.0_wp
579          IF ( timestep_scheme(1:5) == 'runge' )  THEN
580             IF ( ws_scheme_mom )  THEN
581                CALL advec_w_ws( i, j, i_omp_start, tn )
[2155]582             ELSE
[1875]583                CALL advec_w_pw( i, j )
584             END IF
585          ELSE
586             CALL advec_w_up( i, j )
587          ENDIF
588          CALL diffusion_w( i, j )
589          CALL coriolis( i, j, 3 )
590
591          IF ( .NOT. neutral )  THEN
[3294]592             IF ( ocean_mode )  THEN
[2031]593                CALL buoyancy( i, j, rho_ocean, 3 )
[1875]594             ELSE
595                IF ( .NOT. humidity )  THEN
596                   CALL buoyancy( i, j, pt, 3 )
597                ELSE
598                   CALL buoyancy( i, j, vpt, 3 )
599                ENDIF
600             ENDIF
601          ENDIF
602
603!
604!--       Drag by plant canopy
605          IF ( plant_canopy )  CALL pcm_tendency( i, j, 3 )
606
[1914]607!
[3302]608!--       Effect of Stokes drift (in ocean mode only)
609          IF ( stokes_force )  CALL stokes_drift_terms( i, j, 3 )
610
[3684]611          CALL module_interface_actions( i, j, 'w-tendency' )
[1875]612!
613!--       Prognostic equation for w-velocity component
[2232]614          DO  k = nzb+1, nzt-1
[4649]615             w_p(k,j,i) = w(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) )     &
616                                       - tsc(5) * rdf(k) * w(k,j,i) )                              &
617                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
[1875]618          ENDDO
619
620!
621!--       Calculate tendencies for the next Runge-Kutta step
622          IF ( timestep_scheme(1:5) == 'runge' )  THEN
623             IF ( intermediate_timestep_count == 1 )  THEN
[2232]624                DO  k = nzb+1, nzt-1
[1875]625                   tw_m(k,j,i) = tend(k,j,i)
626                ENDDO
[4649]627             ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[2232]628                DO  k = nzb+1, nzt-1
[4649]629                   tw_m(k,j,i) = -9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
[1875]630                ENDDO
631             ENDIF
632          ENDIF
633
634!
635!--       If required, compute prognostic equation for potential temperature
636          IF ( .NOT. neutral )  THEN
637!
638!--          Tendency terms for potential temperature
639             tend(:,j,i) = 0.0_wp
640             IF ( timestep_scheme(1:5) == 'runge' )  THEN
641                   IF ( ws_scheme_sca )  THEN
[4649]642                      CALL advec_s_ws( advc_flags_s, i, j, pt, 'pt', flux_s_pt, diss_s_pt,         &
643                                       flux_l_pt, diss_l_pt, i_omp_start, tn,                      &
644                                       bc_dirichlet_l  .OR.  bc_radiation_l,                       &
645                                       bc_dirichlet_n  .OR.  bc_radiation_n,                       &
646                                       bc_dirichlet_r  .OR.  bc_radiation_r,                       &
[4109]647                                       bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]648                   ELSE
649                      CALL advec_s_pw( i, j, pt )
650                   ENDIF
651             ELSE
652                CALL advec_s_up( i, j, pt )
653             ENDIF
[4649]654             CALL diffusion_s( i, j, pt, surf_def_h(0)%shf, surf_def_h(1)%shf, surf_def_h(2)%shf,  &
[4671]655                               surf_lsm_h(0)%shf, surf_lsm_h(1)%shf,                               &
656                               surf_usm_h(0)%shf, surf_usm_h(1)%shf,                               &
657                               surf_def_v(0)%shf, surf_def_v(1)%shf, surf_def_v(2)%shf,            &
658                               surf_def_v(3)%shf, surf_lsm_v(0)%shf, surf_lsm_v(1)%shf,            &
659                               surf_lsm_v(2)%shf, surf_lsm_v(3)%shf, surf_usm_v(0)%shf,            &
660                               surf_usm_v(1)%shf, surf_usm_v(2)%shf, surf_usm_v(3)%shf )
[1875]661
662!
663!--          Consideration of heat sources within the plant canopy
[4649]664             IF ( plant_canopy  .AND.  (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  &
665             THEN
[1875]666                CALL pcm_tendency( i, j, 4 )
667             ENDIF
668
669!
670!--          Large scale advection
671             IF ( large_scale_forcing )  THEN
672                CALL ls_advec( i, j, simulated_time, 'pt' )
[2155]673             ENDIF
[1875]674
675!
676!--          Nudging
[2155]677             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' )
[1875]678
679!
680!--          If required, compute effect of large-scale subsidence/ascent
[4649]681             IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies )  THEN
[1875]682                CALL subsidence( i, j, tend, pt, pt_init, 2 )
683             ENDIF
684
[3771]685#if defined( __rrtmg )
[1875]686!
687!--          If required, add tendency due to radiative heating/cooling
[4649]688             IF ( radiation  .AND.  simulated_time > skip_time_do_radiation )  THEN
[1875]689                CALL radiation_tendency ( i, j, tend )
690             ENDIF
[3771]691#endif
[1875]692
[3684]693             CALL module_interface_actions( i, j, 'pt-tendency' )
[1875]694!
695!--          Prognostic equation for potential temperature
[2232]696             DO  k = nzb+1, nzt
[4649]697                pt_p(k,j,i) = pt(k,j,i) +                                                          &
698                              ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) ) - tsc(5)  &
699                                * ( pt(k,j,i) - pt_init(k) ) * ( rdf_sc(k) + ptdf_x(i)             &
700                                                                 + ptdf_y(j) ) )                   &
701                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1875]702             ENDDO
703
704!
705!--          Calculate tendencies for the next Runge-Kutta step
706             IF ( timestep_scheme(1:5) == 'runge' )  THEN
707                IF ( intermediate_timestep_count == 1 )  THEN
[2232]708                   DO  k = nzb+1, nzt
[1875]709                      tpt_m(k,j,i) = tend(k,j,i)
710                   ENDDO
[4649]711                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[2232]712                   DO  k = nzb+1, nzt
[4649]713                      tpt_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tpt_m(k,j,i)
[1875]714                   ENDDO
715                ENDIF
716             ENDIF
717
718          ENDIF
719
720!
[1960]721!--       If required, compute prognostic equation for total water content
722          IF ( humidity )  THEN
[1875]723
724!
725!--          Tendency-terms for total water content / scalar
726             tend(:,j,i) = 0.0_wp
[4649]727             IF ( timestep_scheme(1:5) == 'runge' )  THEN
[1875]728                IF ( ws_scheme_sca )  THEN
[4649]729                   CALL advec_s_ws( advc_flags_s, i, j, q, 'q', flux_s_q, diss_s_q, flux_l_q,      &
730                                    diss_l_q, i_omp_start, tn,                                     &
731                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
732                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
733                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
[4109]734                                    bc_dirichlet_s  .OR.  bc_radiation_s )
[2155]735                ELSE
[1875]736                   CALL advec_s_pw( i, j, q )
737                ENDIF
738             ELSE
739                CALL advec_s_up( i, j, q )
740             ENDIF
[4649]741             CALL diffusion_s( i, j, q, surf_def_h(0)%qsws, surf_def_h(1)%qsws,                    &
[4671]742                               surf_def_h(2)%qsws, surf_lsm_h(0)%qsws, surf_lsm_h(1)%qsws,         &
743                               surf_usm_h(0)%qsws, surf_usm_h(1)%qsws,                             &
[4649]744                               surf_def_v(0)%qsws, surf_def_v(1)%qsws, surf_def_v(2)%qsws,         &
745                               surf_def_v(3)%qsws, surf_lsm_v(0)%qsws, surf_lsm_v(1)%qsws,         &
746                               surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws, surf_usm_v(0)%qsws,         &
747                               surf_usm_v(1)%qsws, surf_usm_v(2)%qsws, surf_usm_v(3)%qsws )
[1875]748
749!
[1960]750!--          Sink or source of humidity due to canopy elements
[1875]751             IF ( plant_canopy )  CALL pcm_tendency( i, j, 5 )
752
753!
754!--          Large scale advection
755             IF ( large_scale_forcing )  THEN
756                CALL ls_advec( i, j, simulated_time, 'q' )
757             ENDIF
758
759!
760!--          Nudging
[2155]761             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' )
[1875]762
763!
764!--          If required compute influence of large-scale subsidence/ascent
[4649]765             IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies )  THEN
[1875]766                CALL subsidence( i, j, tend, q, q_init, 3 )
767             ENDIF
768
[3684]769             CALL module_interface_actions( i, j, 'q-tendency' )
[1875]770
771!
772!--          Prognostic equation for total water content / scalar
[2232]773             DO  k = nzb+1, nzt
[4649]774                q_p(k,j,i) = q(k,j,i)                                                              &
775                             + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tq_m(k,j,i) ) - tsc(5)  &
776                                 * rdf_sc(k) * ( q(k,j,i) - q_init(k) ) )                          &
777                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1875]778                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
779             ENDDO
780
781!
782!--          Calculate tendencies for the next Runge-Kutta step
783             IF ( timestep_scheme(1:5) == 'runge' )  THEN
784                IF ( intermediate_timestep_count == 1 )  THEN
[2232]785                   DO  k = nzb+1, nzt
[1875]786                      tq_m(k,j,i) = tend(k,j,i)
787                   ENDDO
788                ELSEIF ( intermediate_timestep_count < &
789                         intermediate_timestep_count_max )  THEN
[2232]790                   DO  k = nzb+1, nzt
[4649]791                      tq_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
[1875]792                   ENDDO
793                ENDIF
794             ENDIF
795
796          ENDIF
[2155]797
[1960]798!
799!--       If required, compute prognostic equation for scalar
800          IF ( passive_scalar )  THEN
801!
802!--          Tendency-terms for total water content / scalar
803             tend(:,j,i) = 0.0_wp
[4649]804             IF ( timestep_scheme(1:5) == 'runge' )  THEN
[1960]805                IF ( ws_scheme_sca )  THEN
[4079]806!
[4649]807!--                For scalar advection apply monotonic flux limiter near topography.
808                   CALL advec_s_ws( advc_flags_s, i, j, s, 's', flux_s_s, diss_s_s, flux_l_s,      &
809                                    diss_l_s, i_omp_start, tn,                                     &
810                                    bc_dirichlet_l  .OR.  bc_radiation_l,                          &
811                                    bc_dirichlet_n  .OR.  bc_radiation_n,                          &
812                                    bc_dirichlet_r  .OR.  bc_radiation_r,                          &
813                                    bc_dirichlet_s  .OR.  bc_radiation_s,                          &
[4109]814                                    monotonic_limiter_z )
[2155]815                ELSE
[1960]816                   CALL advec_s_pw( i, j, s )
817                ENDIF
818             ELSE
819                CALL advec_s_up( i, j, s )
820             ENDIF
[4649]821             CALL diffusion_s( i, j, s, surf_def_h(0)%ssws, surf_def_h(1)%ssws,                    &
[4671]822                               surf_def_h(2)%ssws, surf_lsm_h(0)%ssws, surf_lsm_h(1)%ssws,         &
823                               surf_usm_h(0)%ssws, surf_usm_h(1)%ssws,                             &
[4649]824                               surf_def_v(0)%ssws, surf_def_v(1)%ssws, surf_def_v(2)%ssws,         &
825                               surf_def_v(3)%ssws, surf_lsm_v(0)%ssws, surf_lsm_v(1)%ssws,         &
826                               surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws, surf_usm_v(0)%ssws,         &
827                               surf_usm_v(1)%ssws, surf_usm_v(2)%ssws, surf_usm_v(3)%ssws )
[1875]828
829!
[1960]830!--          Sink or source of scalar concentration due to canopy elements
831             IF ( plant_canopy )  CALL pcm_tendency( i, j, 7 )
832
833!
834!--          Large scale advection, still need to be extended for scalars
835!              IF ( large_scale_forcing )  THEN
836!                 CALL ls_advec( i, j, simulated_time, 's' )
837!              ENDIF
838
839!
840!--          Nudging, still need to be extended for scalars
[2155]841!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' )
[1960]842
843!
[4649]844!--          If required compute influence of large-scale subsidence/ascent. Note, the last argument
845!--          is of no meaning in this case, as it is only used in conjunction with
846!--          large_scale_forcing, which is to date not implemented for scalars.
847             IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies  .AND.            &
[1960]848                  .NOT. large_scale_forcing )  THEN
849                CALL subsidence( i, j, tend, s, s_init, 3 )
850             ENDIF
851
[3684]852             CALL module_interface_actions( i, j, 's-tendency' )
[1960]853
854!
855!--          Prognostic equation for scalar
[2232]856             DO  k = nzb+1, nzt
[4649]857                s_p(k,j,i) = s(k,j,i)                                                              &
858                             + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * ts_m(k,j,i) )           &
859                                 - tsc(5) * rdf_sc(k) * ( s(k,j,i) - s_init(k) ) )                 &
860                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1960]861                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
862             ENDDO
863
864!
865!--          Calculate tendencies for the next Runge-Kutta step
866             IF ( timestep_scheme(1:5) == 'runge' )  THEN
867                IF ( intermediate_timestep_count == 1 )  THEN
[2232]868                   DO  k = nzb+1, nzt
[1960]869                      ts_m(k,j,i) = tend(k,j,i)
870                   ENDDO
[4649]871                ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[2232]872                   DO  k = nzb+1, nzt
[4649]873                      ts_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * ts_m(k,j,i)
[1960]874                   ENDDO
875                ENDIF
876             ENDIF
877
[2155]878          ENDIF
[1960]879!
[3837]880!--       Calculate prognostic equations for all other modules
881          CALL module_interface_prognostic_equations( i, j, i_omp_start, tn )
[1875]882
[3294]883       ENDDO  ! loop over j
884    ENDDO  ! loop over i
[2192]885    !$OMP END PARALLEL
[1875]886
[2232]887
[1875]888    CALL cpu_log( log_point(32), 'all progn.equations', 'stop' )
889
[3987]890    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_cache', 'end' )
[1875]891
892 END SUBROUTINE prognostic_equations_cache
893
894
[4649]895!--------------------------------------------------------------------------------------------------!
[1875]896! Description:
897! ------------
898!> Version for vector machines
[4649]899!--------------------------------------------------------------------------------------------------!
[2155]900
[1875]901 SUBROUTINE prognostic_equations_vector
902
903
[4649]904    INTEGER(iwp) ::  i  !<
905    INTEGER(iwp) ::  j  !<
906    INTEGER(iwp) ::  k  !<
[1875]907
[4649]908    REAL(wp) ::  sbt  !<
[1875]909
[3885]910
[3987]911    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'start' )
[3467]912!
[3931]913!-- Calculate non advective processes for all other modules
914    CALL module_interface_non_advective_processes
[1875]915!
[4649]916!-- Module Inferface for exchange horiz after non_advective_processes but before advection.
917!-- Therefore, non_advective_processes must not run for ghost points.
[3887]918    CALL module_interface_exchange_horiz()
919!
[1875]920!-- u-velocity component
921    CALL cpu_log( log_point(5), 'u-equation', 'start' )
922
[3634]923    !$ACC KERNELS PRESENT(tend)
[1875]924    tend = 0.0_wp
[3634]925    !$ACC END KERNELS
[1875]926    IF ( timestep_scheme(1:5) == 'runge' )  THEN
927       IF ( ws_scheme_mom )  THEN
928          CALL advec_u_ws
929       ELSE
930          CALL advec_u_pw
931       ENDIF
932    ELSE
933       CALL advec_u_up
934    ENDIF
935    CALL diffusion_u
936    CALL coriolis( 1 )
937    IF ( sloping_surface  .AND.  .NOT. neutral )  THEN
938       CALL buoyancy( pt, 1 )
939    ENDIF
940
941!
942!-- Drag by plant canopy
943    IF ( plant_canopy )  CALL pcm_tendency( 1 )
944
945!
946!-- External pressure gradient
947    IF ( dp_external )  THEN
948       DO  i = nxlu, nxr
949          DO  j = nys, nyn
950             DO  k = dp_level_ind_b+1, nzt
951                tend(k,j,i) = tend(k,j,i) - dpdxy(1) * dp_smooth_factor(k)
952             ENDDO
953          ENDDO
954       ENDDO
955    ENDIF
956
957!
958!-- Nudging
959    IF ( nudging )  CALL nudge( simulated_time, 'u' )
960
[1914]961!
[3302]962!-- Effect of Stokes drift (in ocean mode only)
963    IF ( stokes_force )  CALL stokes_drift_terms( 1 )
964
[3684]965    CALL module_interface_actions( 'u-tendency' )
[1875]966
967!
968!-- Prognostic equation for u-velocity component
[3634]969    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
[4346]970    !$ACC PRESENT(u, tend, tu_m, u_init, rdf, wall_flags_total_0) &
[3634]971    !$ACC PRESENT(tsc(2:5)) &
972    !$ACC PRESENT(u_p)
[1875]973    DO  i = nxlu, nxr
974       DO  j = nys, nyn
[4649]975!
976!--       Following directive is required to vectorize on Intel19
[4370]977          !DIR$ IVDEP
[2232]978          DO  k = nzb+1, nzt
[4649]979             u_p(k,j,i) = u(k,j,i)                                                                 &
980                          + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) )              &
981                              - tsc(5) * rdf(k) * ( u(k,j,i) - u_init(k) ) )                       &
982                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
[1875]983          ENDDO
984       ENDDO
985    ENDDO
986
987!
[3302]988!-- Add turbulence generated by wave breaking (in ocean mode only)
[4649]989    IF ( wave_breaking .AND. intermediate_timestep_count == intermediate_timestep_count_max )  THEN
[3302]990       CALL wave_breaking_term( 1 )
991    ENDIF
992
993!
[1875]994!-- Calculate tendencies for the next Runge-Kutta step
995    IF ( timestep_scheme(1:5) == 'runge' )  THEN
996       IF ( intermediate_timestep_count == 1 )  THEN
[3634]997          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
998          !$ACC PRESENT(tend, tu_m)
[1875]999          DO  i = nxlu, nxr
1000             DO  j = nys, nyn
[2232]1001                DO  k = nzb+1, nzt
[1875]1002                   tu_m(k,j,i) = tend(k,j,i)
1003                ENDDO
1004             ENDDO
1005          ENDDO
[4649]1006       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[3634]1007          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1008          !$ACC PRESENT(tend, tu_m)
[1875]1009          DO  i = nxlu, nxr
1010             DO  j = nys, nyn
[2232]1011                DO  k = nzb+1, nzt
[4649]1012                   tu_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tu_m(k,j,i)
[1875]1013                ENDDO
1014             ENDDO
1015          ENDDO
1016       ENDIF
1017    ENDIF
1018
1019    CALL cpu_log( log_point(5), 'u-equation', 'stop' )
1020
1021!
1022!-- v-velocity component
1023    CALL cpu_log( log_point(6), 'v-equation', 'start' )
1024
[3634]1025    !$ACC KERNELS PRESENT(tend)
[1875]1026    tend = 0.0_wp
[3634]1027    !$ACC END KERNELS
[1875]1028    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1029       IF ( ws_scheme_mom )  THEN
1030          CALL advec_v_ws
[2155]1031       ELSE
[1875]1032          CALL advec_v_pw
1033       END IF
1034    ELSE
1035       CALL advec_v_up
1036    ENDIF
1037    CALL diffusion_v
1038    CALL coriolis( 2 )
1039
1040!
1041!-- Drag by plant canopy
1042    IF ( plant_canopy )  CALL pcm_tendency( 2 )
1043
1044!
1045!-- External pressure gradient
1046    IF ( dp_external )  THEN
1047       DO  i = nxl, nxr
1048          DO  j = nysv, nyn
1049             DO  k = dp_level_ind_b+1, nzt
1050                tend(k,j,i) = tend(k,j,i) - dpdxy(2) * dp_smooth_factor(k)
1051             ENDDO
1052          ENDDO
1053       ENDDO
1054    ENDIF
1055
1056!
1057!-- Nudging
1058    IF ( nudging )  CALL nudge( simulated_time, 'v' )
1059
[1914]1060!
[3302]1061!-- Effect of Stokes drift (in ocean mode only)
1062    IF ( stokes_force )  CALL stokes_drift_terms( 2 )
1063
[3684]1064    CALL module_interface_actions( 'v-tendency' )
[1875]1065
1066!
1067!-- Prognostic equation for v-velocity component
[3634]1068    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
[4346]1069    !$ACC PRESENT(v, tend, tv_m, v_init, rdf, wall_flags_total_0) &
[3634]1070    !$ACC PRESENT(tsc(2:5)) &
1071    !$ACC PRESENT(v_p)
[1875]1072    DO  i = nxl, nxr
1073       DO  j = nysv, nyn
[4649]1074!
1075!--       Following directive is required to vectorize on Intel19
[4370]1076          !DIR$ IVDEP
[2232]1077          DO  k = nzb+1, nzt
[4649]1078             v_p(k,j,i) = v(k,j,i)                                                                 &
1079                          + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) ) - tsc(5)     &
1080                              * rdf(k) * ( v(k,j,i) - v_init(k) ) )                                &
1081                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
[1875]1082          ENDDO
1083       ENDDO
1084    ENDDO
1085
1086!
[3302]1087!-- Add turbulence generated by wave breaking (in ocean mode only)
[4649]1088    IF ( wave_breaking .AND. intermediate_timestep_count == intermediate_timestep_count_max )  THEN
[3302]1089       CALL wave_breaking_term( 2 )
1090    ENDIF
1091
1092!
[1875]1093!-- Calculate tendencies for the next Runge-Kutta step
1094    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1095       IF ( intermediate_timestep_count == 1 )  THEN
[3634]1096          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1097          !$ACC PRESENT(tend, tv_m)
[1875]1098          DO  i = nxl, nxr
1099             DO  j = nysv, nyn
[2232]1100                DO  k = nzb+1, nzt
[1875]1101                   tv_m(k,j,i) = tend(k,j,i)
1102                ENDDO
1103             ENDDO
1104          ENDDO
[4649]1105       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[3634]1106          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1107          !$ACC PRESENT(tend, tv_m)
[1875]1108          DO  i = nxl, nxr
1109             DO  j = nysv, nyn
[2232]1110                DO  k = nzb+1, nzt
[4649]1111                   tv_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tv_m(k,j,i)
[1875]1112                ENDDO
1113             ENDDO
1114          ENDDO
1115       ENDIF
1116    ENDIF
1117
1118    CALL cpu_log( log_point(6), 'v-equation', 'stop' )
1119
1120!
1121!-- w-velocity component
1122    CALL cpu_log( log_point(7), 'w-equation', 'start' )
1123
[3634]1124    !$ACC KERNELS PRESENT(tend)
[1875]1125    tend = 0.0_wp
[3634]1126    !$ACC END KERNELS
[1875]1127    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1128       IF ( ws_scheme_mom )  THEN
1129          CALL advec_w_ws
1130       ELSE
1131          CALL advec_w_pw
1132       ENDIF
1133    ELSE
1134       CALL advec_w_up
1135    ENDIF
1136    CALL diffusion_w
1137    CALL coriolis( 3 )
1138
1139    IF ( .NOT. neutral )  THEN
[3294]1140       IF ( ocean_mode )  THEN
[2031]1141          CALL buoyancy( rho_ocean, 3 )
[1875]1142       ELSE
1143          IF ( .NOT. humidity )  THEN
1144             CALL buoyancy( pt, 3 )
1145          ELSE
1146             CALL buoyancy( vpt, 3 )
1147          ENDIF
1148       ENDIF
1149    ENDIF
1150
1151!
1152!-- Drag by plant canopy
1153    IF ( plant_canopy )  CALL pcm_tendency( 3 )
1154
[1914]1155!
[3302]1156!-- Effect of Stokes drift (in ocean mode only)
1157    IF ( stokes_force )  CALL stokes_drift_terms( 3 )
1158
[3684]1159    CALL module_interface_actions( 'w-tendency' )
[1875]1160
1161!
1162!-- Prognostic equation for w-velocity component
[3634]1163    !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
[4346]1164    !$ACC PRESENT(w, tend, tw_m, v_init, rdf, wall_flags_total_0) &
[3634]1165    !$ACC PRESENT(tsc(2:5)) &
1166    !$ACC PRESENT(w_p)
[1875]1167    DO  i = nxl, nxr
1168       DO  j = nys, nyn
[4649]1169!
1170!--       Following directive is required to vectorize on Intel19
[4370]1171          !DIR$ IVDEP
[2232]1172          DO  k = nzb+1, nzt-1
[4649]1173             w_p(k,j,i) = w(k,j,i)                                                                 &
1174                          + ( dt_3d * ( tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) )              &
1175                              - tsc(5) * rdf(k) * w(k,j,i) )                                       &
1176                          * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
[1875]1177          ENDDO
1178       ENDDO
1179    ENDDO
1180
1181!
1182!-- Calculate tendencies for the next Runge-Kutta step
1183    IF ( timestep_scheme(1:5) == 'runge' )  THEN
1184       IF ( intermediate_timestep_count == 1 )  THEN
[3634]1185          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1186          !$ACC PRESENT(tend, tw_m)
[1875]1187          DO  i = nxl, nxr
1188             DO  j = nys, nyn
[2232]1189                DO  k = nzb+1, nzt-1
[1875]1190                   tw_m(k,j,i) = tend(k,j,i)
1191                ENDDO
1192             ENDDO
1193          ENDDO
[4649]1194       ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[3634]1195          !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1196          !$ACC PRESENT(tend, tw_m)
[1875]1197          DO  i = nxl, nxr
1198             DO  j = nys, nyn
[2232]1199                DO  k = nzb+1, nzt-1
[4649]1200                   tw_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tw_m(k,j,i)
[1875]1201                ENDDO
1202             ENDDO
1203          ENDDO
1204       ENDIF
1205    ENDIF
1206
1207    CALL cpu_log( log_point(7), 'w-equation', 'stop' )
1208
1209
1210!
1211!-- If required, compute prognostic equation for potential temperature
1212    IF ( .NOT. neutral )  THEN
1213
1214       CALL cpu_log( log_point(13), 'pt-equation', 'start' )
1215
1216!
1217!--    pt-tendency terms with communication
1218       sbt = tsc(2)
1219       IF ( scalar_advec == 'bc-scheme' )  THEN
1220
1221          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1222!
1223!--          Bott-Chlond scheme always uses Euler time step. Thus:
1224             sbt = 1.0_wp
1225          ENDIF
1226          tend = 0.0_wp
1227          CALL advec_s_bc( pt, 'pt' )
1228
1229       ENDIF
1230
1231!
1232!--    pt-tendency terms with no communication
1233       IF ( scalar_advec /= 'bc-scheme' )  THEN
[3634]1234          !$ACC KERNELS PRESENT(tend)
[1875]1235          tend = 0.0_wp
[3634]1236          !$ACC END KERNELS
[1875]1237          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1238             IF ( ws_scheme_sca )  THEN
[4649]1239                CALL advec_s_ws( advc_flags_s, pt, 'pt',                                           &
1240                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
1241                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
1242                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
[4109]1243                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]1244             ELSE
1245                CALL advec_s_pw( pt )
1246             ENDIF
1247          ELSE
1248             CALL advec_s_up( pt )
1249          ENDIF
1250       ENDIF
1251
[4649]1252       CALL diffusion_s( pt, surf_def_h(0)%shf, surf_def_h(1)%shf, surf_def_h(2)%shf,              &
[4671]1253                         surf_lsm_h(0)%shf, surf_lsm_h(1)%shf, surf_usm_h(0)%shf,                  &
1254                         surf_usm_h(1)%shf, surf_def_v(0)%shf, surf_def_v(1)%shf,                  &
[4649]1255                         surf_def_v(2)%shf, surf_def_v(3)%shf, surf_lsm_v(0)%shf,                  &
1256                         surf_lsm_v(1)%shf, surf_lsm_v(2)%shf, surf_lsm_v(3)%shf,                  &
1257                         surf_usm_v(0)%shf, surf_usm_v(1)%shf, surf_usm_v(2)%shf,                  &
1258                         surf_usm_v(3)%shf )
[1875]1259
1260!
1261!--    Consideration of heat sources within the plant canopy
[4649]1262       IF ( plant_canopy  .AND.  (cthf /= 0.0_wp  .OR. urban_surface  .OR.  land_surface) )  THEN
[1875]1263          CALL pcm_tendency( 4 )
1264       ENDIF
1265
1266!
1267!--    Large scale advection
1268       IF ( large_scale_forcing )  THEN
1269          CALL ls_advec( simulated_time, 'pt' )
1270       ENDIF
1271
1272!
1273!--    Nudging
[2155]1274       IF ( nudging )  CALL nudge( simulated_time, 'pt' )
[1875]1275
1276!
1277!--    If required compute influence of large-scale subsidence/ascent
[4649]1278       IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies )  THEN
[1875]1279          CALL subsidence( tend, pt, pt_init, 2 )
1280       ENDIF
1281
[3771]1282#if defined( __rrtmg )
[1875]1283!
1284!--    If required, add tendency due to radiative heating/cooling
[4649]1285       IF ( radiation  .AND.  simulated_time > skip_time_do_radiation )  THEN
[1875]1286            CALL radiation_tendency ( tend )
1287       ENDIF
[3771]1288#endif
[1875]1289
[3684]1290       CALL module_interface_actions( 'pt-tendency' )
[1875]1291
1292!
1293!--    Prognostic equation for potential temperature
[3634]1294       !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
[4346]1295       !$ACC PRESENT(pt, tend, tpt_m, wall_flags_total_0) &
[3634]1296       !$ACC PRESENT(pt_init, rdf_sc, ptdf_x, ptdf_y) &
1297       !$ACC PRESENT(tsc(3:5)) &
1298       !$ACC PRESENT(pt_p)
[1875]1299       DO  i = nxl, nxr
1300          DO  j = nys, nyn
[4649]1301!
1302!--          Following directive is required to vectorize on Intel19
[4370]1303             !DIR$ IVDEP
[2232]1304             DO  k = nzb+1, nzt
[4649]1305                pt_p(k,j,i) = pt(k,j,i)                                                            &
1306                              + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) )            &
1307                                  - tsc(5) * ( pt(k,j,i) - pt_init(k) )                            &
1308                                  * ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) )                        &
1309                              * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1875]1310             ENDDO
1311          ENDDO
1312       ENDDO
1313!
1314!--    Calculate tendencies for the next Runge-Kutta step
1315       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1316          IF ( intermediate_timestep_count == 1 )  THEN
[3634]1317             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1318             !$ACC PRESENT(tend, tpt_m)
[1875]1319             DO  i = nxl, nxr
1320                DO  j = nys, nyn
[2232]1321                   DO  k = nzb+1, nzt
[1875]1322                      tpt_m(k,j,i) = tend(k,j,i)
1323                   ENDDO
1324                ENDDO
1325             ENDDO
[4649]1326          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[3634]1327             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k) &
1328             !$ACC PRESENT(tend, tpt_m)
[1875]1329             DO  i = nxl, nxr
1330                DO  j = nys, nyn
[2232]1331                   DO  k = nzb+1, nzt
[4649]1332                      tpt_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tpt_m(k,j,i)
[1875]1333                   ENDDO
1334                ENDDO
1335             ENDDO
1336          ENDIF
1337       ENDIF
1338
1339       CALL cpu_log( log_point(13), 'pt-equation', 'stop' )
1340
1341    ENDIF
1342
1343!
[1960]1344!-- If required, compute prognostic equation for total water content
1345    IF ( humidity )  THEN
[1875]1346
[1960]1347       CALL cpu_log( log_point(29), 'q-equation', 'start' )
[1875]1348
1349!
1350!--    Scalar/q-tendency terms with communication
1351       sbt = tsc(2)
1352       IF ( scalar_advec == 'bc-scheme' )  THEN
1353
1354          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1355!
1356!--          Bott-Chlond scheme always uses Euler time step. Thus:
1357             sbt = 1.0_wp
1358          ENDIF
1359          tend = 0.0_wp
1360          CALL advec_s_bc( q, 'q' )
1361
1362       ENDIF
1363
1364!
1365!--    Scalar/q-tendency terms with no communication
1366       IF ( scalar_advec /= 'bc-scheme' )  THEN
1367          tend = 0.0_wp
1368          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1369             IF ( ws_scheme_sca )  THEN
[4649]1370                CALL advec_s_ws( advc_flags_s, q, 'q',                                             &
1371                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
1372                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
1373                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
[4109]1374                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1875]1375             ELSE
1376                CALL advec_s_pw( q )
1377             ENDIF
1378          ELSE
1379             CALL advec_s_up( q )
1380          ENDIF
1381       ENDIF
1382
[4649]1383       CALL diffusion_s( q, surf_def_h(0)%qsws, surf_def_h(1)%qsws, surf_def_h(2)%qsws,            &
[4671]1384                         surf_lsm_h(0)%qsws, surf_lsm_h(1)%qsws, surf_usm_h(0)%qsws,               &
1385                         surf_usm_h(0)%qsws, surf_def_v(0)%qsws, surf_def_v(1)%qsws,               &
[4649]1386                         surf_def_v(2)%qsws, surf_def_v(3)%qsws, surf_lsm_v(0)%qsws,               &
1387                         surf_lsm_v(1)%qsws, surf_lsm_v(2)%qsws, surf_lsm_v(3)%qsws,               &
1388                         surf_usm_v(0)%qsws, surf_usm_v(1)%qsws, surf_usm_v(2)%qsws,               &
1389                         surf_usm_v(3)%qsws )
[2155]1390
[1875]1391!
[1960]1392!--    Sink or source of humidity due to canopy elements
[1875]1393       IF ( plant_canopy ) CALL pcm_tendency( 5 )
1394
1395!
1396!--    Large scale advection
1397       IF ( large_scale_forcing )  THEN
1398          CALL ls_advec( simulated_time, 'q' )
1399       ENDIF
1400
1401!
1402!--    Nudging
[2155]1403       IF ( nudging )  CALL nudge( simulated_time, 'q' )
[1875]1404
1405!
1406!--    If required compute influence of large-scale subsidence/ascent
[4649]1407       IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies )  THEN
[1875]1408         CALL subsidence( tend, q, q_init, 3 )
1409       ENDIF
1410
[3684]1411       CALL module_interface_actions( 'q-tendency' )
[1875]1412
1413!
[1960]1414!--    Prognostic equation for total water content
[1875]1415       DO  i = nxl, nxr
1416          DO  j = nys, nyn
[4649]1417!
1418!--          Following directive is required to vectorize on Intel19
[4370]1419             !DIR$ IVDEP
[2232]1420             DO  k = nzb+1, nzt
[4649]1421                q_p(k,j,i) = q(k,j,i)                                                              &
1422                             + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) )              &
1423                                 - tsc(5) * rdf_sc(k) * ( q(k,j,i) - q_init(k) ) )                 &
1424                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1875]1425                IF ( q_p(k,j,i) < 0.0_wp )  q_p(k,j,i) = 0.1_wp * q(k,j,i)
1426             ENDDO
1427          ENDDO
1428       ENDDO
1429
1430!
1431!--    Calculate tendencies for the next Runge-Kutta step
1432       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1433          IF ( intermediate_timestep_count == 1 )  THEN
1434             DO  i = nxl, nxr
1435                DO  j = nys, nyn
[2232]1436                   DO  k = nzb+1, nzt
[1875]1437                      tq_m(k,j,i) = tend(k,j,i)
1438                   ENDDO
1439                ENDDO
1440             ENDDO
[4649]1441          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[1875]1442             DO  i = nxl, nxr
1443                DO  j = nys, nyn
[2232]1444                   DO  k = nzb+1, nzt
[4649]1445                      tq_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * tq_m(k,j,i)
[1875]1446                   ENDDO
1447                ENDDO
1448             ENDDO
1449          ENDIF
1450       ENDIF
1451
[1960]1452       CALL cpu_log( log_point(29), 'q-equation', 'stop' )
[1875]1453
1454    ENDIF
[1960]1455!
1456!-- If required, compute prognostic equation for scalar
1457    IF ( passive_scalar )  THEN
[1875]1458
[1960]1459       CALL cpu_log( log_point(66), 's-equation', 'start' )
1460
[1875]1461!
[1960]1462!--    Scalar/q-tendency terms with communication
1463       sbt = tsc(2)
1464       IF ( scalar_advec == 'bc-scheme' )  THEN
1465
1466          IF ( timestep_scheme(1:5) /= 'runge' )  THEN
1467!
1468!--          Bott-Chlond scheme always uses Euler time step. Thus:
1469             sbt = 1.0_wp
1470          ENDIF
1471          tend = 0.0_wp
1472          CALL advec_s_bc( s, 's' )
1473
1474       ENDIF
1475
1476!
1477!--    Scalar/q-tendency terms with no communication
1478       IF ( scalar_advec /= 'bc-scheme' )  THEN
1479          tend = 0.0_wp
1480          IF ( timestep_scheme(1:5) == 'runge' )  THEN
1481             IF ( ws_scheme_sca )  THEN
[4649]1482                CALL advec_s_ws( advc_flags_s, s, 's',                                             &
1483                                 bc_dirichlet_l  .OR.  bc_radiation_l,                             &
1484                                 bc_dirichlet_n  .OR.  bc_radiation_n,                             &
1485                                 bc_dirichlet_r  .OR.  bc_radiation_r,                             &
[4109]1486                                 bc_dirichlet_s  .OR.  bc_radiation_s )
[1960]1487             ELSE
1488                CALL advec_s_pw( s )
1489             ENDIF
1490          ELSE
1491             CALL advec_s_up( s )
1492          ENDIF
1493       ENDIF
1494
[4649]1495       CALL diffusion_s( s, surf_def_h(0)%ssws, surf_def_h(1)%ssws, surf_def_h(2)%ssws,            &
[4671]1496                         surf_lsm_h(0)%ssws, surf_lsm_h(1)%ssws, surf_usm_h(0)%ssws,               &
1497                         surf_usm_h(1)%ssws, surf_def_v(0)%ssws, surf_def_v(1)%ssws,               &
[4649]1498                         surf_def_v(2)%ssws, surf_def_v(3)%ssws, surf_lsm_v(0)%ssws,               &
1499                         surf_lsm_v(1)%ssws, surf_lsm_v(2)%ssws, surf_lsm_v(3)%ssws,               &
1500                         surf_usm_v(0)%ssws, surf_usm_v(1)%ssws, surf_usm_v(2)%ssws,               &
1501                         surf_usm_v(3)%ssws )
[2155]1502
[1960]1503!
1504!--    Sink or source of humidity due to canopy elements
1505       IF ( plant_canopy ) CALL pcm_tendency( 7 )
1506
1507!
1508!--    Large scale advection. Not implemented for scalars so far.
1509!        IF ( large_scale_forcing )  THEN
1510!           CALL ls_advec( simulated_time, 'q' )
1511!        ENDIF
1512
1513!
1514!--    Nudging. Not implemented for scalars so far.
[2155]1515!        IF ( nudging )  CALL nudge( simulated_time, 'q' )
[1960]1516
1517!
1518!--    If required compute influence of large-scale subsidence/ascent.
1519!--    Not implemented for scalars so far.
[4649]1520       IF ( large_scale_subsidence  .AND.  .NOT. use_subsidence_tendencies  .AND.                  &
[1960]1521            .NOT. large_scale_forcing )  THEN
1522         CALL subsidence( tend, s, s_init, 3 )
1523       ENDIF
1524
[3684]1525       CALL module_interface_actions( 's-tendency' )
[1960]1526
1527!
1528!--    Prognostic equation for total water content
1529       DO  i = nxl, nxr
1530          DO  j = nys, nyn
[4649]1531!
1532!--          Following directive is required to vectorize on Intel19
[4370]1533             !DIR$ IVDEP
[2232]1534             DO  k = nzb+1, nzt
[4649]1535                s_p(k,j,i) = s(k,j,i)                                                              &
1536                             + ( dt_3d * ( sbt * tend(k,j,i) + tsc(3) * ts_m(k,j,i) )              &
1537                                 - tsc(5) * rdf_sc(k) * ( s(k,j,i) - s_init(k) ) )                 &
1538                             * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) )
[1960]1539                IF ( s_p(k,j,i) < 0.0_wp )  s_p(k,j,i) = 0.1_wp * s(k,j,i)
1540             ENDDO
1541          ENDDO
1542       ENDDO
1543
1544!
1545!--    Calculate tendencies for the next Runge-Kutta step
1546       IF ( timestep_scheme(1:5) == 'runge' )  THEN
1547          IF ( intermediate_timestep_count == 1 )  THEN
1548             DO  i = nxl, nxr
1549                DO  j = nys, nyn
[2232]1550                   DO  k = nzb+1, nzt
[1960]1551                      ts_m(k,j,i) = tend(k,j,i)
1552                   ENDDO
1553                ENDDO
1554             ENDDO
[4649]1555          ELSEIF ( intermediate_timestep_count < intermediate_timestep_count_max )  THEN
[1960]1556             DO  i = nxl, nxr
1557                DO  j = nys, nyn
[2232]1558                   DO  k = nzb+1, nzt
[4649]1559                      ts_m(k,j,i) = - 9.5625_wp * tend(k,j,i) + 5.3125_wp * ts_m(k,j,i)
[1960]1560                   ENDDO
1561                ENDDO
1562             ENDDO
1563          ENDIF
1564       ENDIF
1565
1566       CALL cpu_log( log_point(66), 's-equation', 'stop' )
1567
1568    ENDIF
[3294]1569!
[3837]1570!-- Calculate prognostic equations for all other modules
1571    CALL module_interface_prognostic_equations()
[1875]1572
[3987]1573    IF ( debug_output_timestep )  CALL debug_message( 'prognostic_equations_vector', 'end' )
[3885]1574
[1875]1575 END SUBROUTINE prognostic_equations_vector
1576
1577
1578 END MODULE prognostic_equations_mod
Note: See TracBrowser for help on using the repository browser.