source: palm/trunk/SOURCE/time_integration.f90 @ 2993

Last change on this file since 2993 was 2984, checked in by hellstea, 7 years ago

Bugfix in the log-law correction initialization and removal of the nest mass-conservation correction

  • Property svn:keywords set to Id
File size: 51.7 KB
Line 
1!> @file time_integration.f90
2!------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2018 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: time_integration.f90 2984 2018-04-18 11:51:30Z raasch $
27! CALL pmci_ensure_nest_mass_conservation is removed (so far only commented out)
28! as seemingly unnecessary.
29!
30! 2941 2018-04-03 11:54:58Z kanani
31! Deduct spinup_time from RUN_CONTROL output of main 3d run
32! (use time_since_reference_point instead of simulated_time)
33!
34! 2938 2018-03-27 15:52:42Z suehring
35! Nesting of dissipation rate in case of RANS mode and TKE-e closure is applied
36!
37! 2936 2018-03-27 14:49:27Z suehring
38! Little formatting adjustment.
39!
40! 2817 2018-02-19 16:32:21Z knoop
41! Preliminary gust module interface implemented
42!
43! 2801 2018-02-14 16:01:55Z thiele
44! Changed lpm from subroutine to module.
45! Introduce particle transfer in nested models.
46!
47! 2776 2018-01-31 10:44:42Z Giersch
48! Variable use_synthetic_turbulence_generator has been abbreviated
49!
50! 2773 2018-01-30 14:12:54Z suehring
51! - Nesting for chemical species
52!
53! 2766 2018-01-22 17:17:47Z kanani
54! Removed preprocessor directive __chem
55!
56! 2718 2018-01-02 08:49:38Z maronga
57! Corrected "Former revisions" section
58!
59! 2696 2017-12-14 17:12:51Z kanani
60! - Change in file header (GPL part)
61! - Implementation of uv exposure model (FK)
62! - Moved vnest_boundary_conds_khkm from tcm_diffusivities to here (TG)
63! - renamed diffusivities to tcm_diffusivities (TG)
64! - implement prognostic equation for diss (TG)
65! - Moved/commented CALL to chem_emissions (FK)
66! - Added CALL to chem_emissions (FK)
67! - Implementation of chemistry module (FK)
68! - Calls for setting boundary conditions in USM and LSM (MS)
69! - Large-scale forcing with larger-scale models implemented (MS)
70! - Rename usm_radiation into radiation_interactions; merge with branch
71!   radiation (MS)
72! - added call for usm_green_heat_model for green building surfaces (RvT)
73! - added call for usm_temperature_near_surface for use in indoor model (RvT)
74!
75! 2617 2017-11-16 12:47:24Z suehring
76! Bugfix, assure that the reference state does not become zero.
77!
78! 2563 2017-10-19 15:36:10Z Giersch
79! Variable wind_turbine moved to module control_parameters
80!
81! 2365 2017-08-21 14:59:59Z kanani
82! Vertical grid nesting implemented (SadiqHuq)
83!
84! 2320 2017-07-21 12:47:43Z suehring
85! Set bottom boundary conditions after nesting interpolation and anterpolation
86!
87! 2299 2017-06-29 10:14:38Z maronga
88! Call of soil model adjusted
89!
90! 2292 2017-06-20 09:51:42Z schwenkel
91! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
92! includes two more prognostic equations for cloud drop concentration (nc) 
93! and cloud water content (qc).
94!
95! 2271 2017-06-09 12:34:55Z sward
96! Start timestep message changed
97!
98! 2259 2017-06-08 09:09:11Z gronemeier
99! Implemented synthetic turbulence generator
100!
101! 2233 2017-05-30 18:08:54Z suehring
102!
103! 2232 2017-05-30 17:47:52Z suehring
104! Adjustments to new topography and surface concept
105! Modify passed parameters for disturb_field
106!
107! 2178 2017-03-17 11:07:39Z hellstea
108! Setting perturbations at all times near inflow boundary is removed
109! in case of nested boundaries
110!
111! 2174 2017-03-13 08:18:57Z maronga
112! Added support for nesting with cloud microphysics
113!
114! 2118 2017-01-17 16:38:49Z raasch
115! OpenACC directives and related code removed
116!
117! 2050 2016-11-08 15:00:55Z gronemeier
118! Implement turbulent outflow condition
119!
120! 2031 2016-10-21 15:11:58Z knoop
121! renamed variable rho to rho_ocean
122!
123! 2011 2016-09-19 17:29:57Z kanani
124! Flag urban_surface is now defined in module control_parameters,
125! removed commented CALLs of global_min_max.
126!
127! 2007 2016-08-24 15:47:17Z kanani
128! Added CALLs for new urban surface model
129!
130! 2000 2016-08-20 18:09:15Z knoop
131! Forced header and separation lines into 80 columns
132!
133! 1976 2016-07-27 13:28:04Z maronga
134! Simplified calls to radiation model
135!
136! 1960 2016-07-12 16:34:24Z suehring
137! Separate humidity and passive scalar
138!
139! 1957 2016-07-07 10:43:48Z suehring
140! flight module added
141!
142! 1919 2016-05-27 14:51:23Z raasch
143! Initial version of purely vertical nesting introduced.
144!
145! 1918 2016-05-27 14:35:57Z raasch
146! determination of time step moved to the end of the time step loop,
147! the first time step is now always calculated before the time step loop (i.e.
148! also in case of restart runs)
149!
150! 1914 2016-05-26 14:44:07Z witha
151! Added call for wind turbine model
152!
153! 1878 2016-04-19 12:30:36Z hellstea
154! Synchronization for nested runs rewritten
155!
156! 1853 2016-04-11 09:00:35Z maronga
157! Adjusted for use with radiation_scheme = constant
158!
159! 1849 2016-04-08 11:33:18Z hoffmann
160! Adapted for modularization of microphysics
161!
162! 1833 2016-04-07 14:23:03Z raasch
163! spectrum renamed spectra_mod, spectra related variables moved to spectra_mod
164!
165! 1831 2016-04-07 13:15:51Z hoffmann
166! turbulence renamed collision_turbulence
167!
168! 1822 2016-04-07 07:49:42Z hoffmann
169! icloud_scheme replaced by microphysics_*
170!
171! 1808 2016-04-05 19:44:00Z raasch
172! output message in case unscheduled radiation calls removed
173!
174! 1797 2016-03-21 16:50:28Z raasch
175! introduction of different datatransfer modes
176!
177! 1791 2016-03-11 10:41:25Z raasch
178! call of pmci_update_new removed
179!
180! 1786 2016-03-08 05:49:27Z raasch
181! +module spectrum
182!
183! 1783 2016-03-06 18:36:17Z raasch
184! switch back of netcdf data format for mask output moved to the mask output
185! routine
186!
187! 1781 2016-03-03 15:12:23Z raasch
188! some pmc calls removed at the beginning (before timeloop),
189! pmc initialization moved to the main program
190!
191! 1764 2016-02-28 12:45:19Z raasch
192! PMC_ACTIVE flags removed,
193! bugfix: nest synchronization after first call of timestep
194!
195! 1762 2016-02-25 12:31:13Z hellstea
196! Introduction of nested domain feature
197!
198! 1736 2015-12-04 08:56:33Z raasch
199! no perturbations added to total domain if energy limit has been set zero
200!
201! 1691 2015-10-26 16:17:44Z maronga
202! Added option for spin-ups without land surface and radiation models. Moved calls
203! for radiation and lan surface schemes.
204!
205! 1682 2015-10-07 23:56:08Z knoop
206! Code annotations made doxygen readable
207!
208! 1671 2015-09-25 03:29:37Z raasch
209! bugfix: ghostpoint exchange for array diss in case that sgs velocities are used
210! for particles
211!
212! 1585 2015-04-30 07:05:52Z maronga
213! Moved call of radiation scheme. Added support for RRTM
214!
215! 1551 2015-03-03 14:18:16Z maronga
216! Added interface for different radiation schemes.
217!
218! 1496 2014-12-02 17:25:50Z maronga
219! Added calls for the land surface model and radiation scheme
220!
221! 1402 2014-05-09 14:25:13Z raasch
222! location messages modified
223!
224! 1384 2014-05-02 14:31:06Z raasch
225! location messages added
226!
227! 1380 2014-04-28 12:40:45Z heinze
228! CALL of nudge_ref added
229! bc_pt_t_val and bc_q_t_val are updated in case nudging is used
230!
231! 1365 2014-04-22 15:03:56Z boeske
232! Reset sums_ls_l to zero at each timestep
233! +sums_ls_l
234! Calculation of reference state (previously in subroutine calc_mean_profile)
235
236! 1342 2014-03-26 17:04:47Z kanani
237! REAL constants defined as wp-kind
238!
239! 1320 2014-03-20 08:40:49Z raasch
240! ONLY-attribute added to USE-statements,
241! kind-parameters added to all INTEGER and REAL declaration statements,
242! kinds are defined in new module kinds,
243! old module precision_kind is removed,
244! revision history before 2012 removed,
245! comment fields (!:) to be used for variable explanations added to
246! all variable declaration statements
247! 1318 2014-03-17 13:35:16Z raasch
248! module interfaces removed
249!
250! 1308 2014-03-13 14:58:42Z fricke
251! +netcdf_data_format_save
252! For masked data, parallel netcdf output is not tested so far, hence
253! netcdf_data_format is switched back to non-paralell output.
254!
255! 1276 2014-01-15 13:40:41Z heinze
256! Use LSF_DATA also in case of Dirichlet bottom boundary condition for scalars
257!
258! 1257 2013-11-08 15:18:40Z raasch
259! acc-update-host directive for timestep removed
260!
261! 1241 2013-10-30 11:36:58Z heinze
262! Generalize calc_mean_profile for wider use
263! Determine shf and qsws in dependence on data from LSF_DATA
264! Determine ug and vg in dependence on data from LSF_DATA
265! 1221 2013-09-10 08:59:13Z raasch
266! host update of arrays before timestep is called
267!
268! 1179 2013-06-14 05:57:58Z raasch
269! mean profiles for reference state are only calculated if required,
270! small bugfix for background communication
271!
272! 1171 2013-05-30 11:27:45Z raasch
273! split of prognostic_equations deactivated (comment lines), for the time being
274!
275! 1128 2013-04-12 06:19:32Z raasch
276! asynchronous transfer of ghost point data realized for acc-optimized version:
277! prognostic_equations are first called two times for those points required for
278! the left-right and north-south exchange, respectively, and then for the
279! remaining points,
280! those parts requiring global communication moved from prognostic_equations to
281! here
282!
283! 1115 2013-03-26 18:16:16Z hoffmann
284! calculation of qr and nr is restricted to precipitation
285!
286! 1113 2013-03-10 02:48:14Z raasch
287! GPU-porting of boundary conditions,
288! openACC directives updated
289! formal parameter removed from routine boundary_conds
290!
291! 1111 2013-03-08 23:54:10Z raasch
292! +internal timestep counter for cpu statistics added,
293! openACC directives updated
294!
295! 1092 2013-02-02 11:24:22Z raasch
296! unused variables removed
297!
298! 1065 2012-11-22 17:42:36Z hoffmann
299! exchange of diss (dissipation rate) in case of turbulence = .TRUE. added
300!
301! 1053 2012-11-13 17:11:03Z hoffmann
302! exchange of ghost points for nr, qr added
303!
304! 1036 2012-10-22 13:43:42Z raasch
305! code put under GPL (PALM 3.9)
306!
307! 1019 2012-09-28 06:46:45Z raasch
308! non-optimized version of prognostic_equations removed
309!
310! 1015 2012-09-27 09:23:24Z raasch
311! +call of prognostic_equations_acc
312!
313! 1001 2012-09-13 14:08:46Z raasch
314! all actions concerning leapfrog- and upstream-spline-scheme removed
315!
316! 849 2012-03-15 10:35:09Z raasch
317! advec_particles renamed lpm, first_call_advec_particles renamed first_call_lpm
318!
319! 825 2012-02-19 03:03:44Z raasch
320! wang_collision_kernel renamed wang_kernel
321!
322! Revision 1.1  1997/08/11 06:19:04  raasch
323! Initial revision
324!
325!
326! Description:
327! ------------
328!> Integration in time of the model equations, statistical analysis and graphic
329!> output
330!------------------------------------------------------------------------------!
331 SUBROUTINE time_integration
332 
333
334    USE advec_ws,                                                              &
335        ONLY:  ws_statistics
336
337    USE arrays_3d,                                                             &
338        ONLY:  diss, diss_p, dzu, e, e_p, nc, nc_p, nr, nr_p, prho, pt, pt_p, pt_init, &
339               q_init, q, qc, qc_p, ql, ql_c, ql_v, ql_vp, qr, qr_p, q_p,      &
340               ref_state, rho_ocean, s, s_p, sa_p, tend, u, u_p, v, vpt,       &
341               v_p, w, w_p
342
343    USE calc_mean_profile_mod,                                                 &
344        ONLY:  calc_mean_profile
345
346    USE chemistry_model_mod,                                                   &
347        ONLY:  chem_emissions, chem_species
348
349    USE chem_modules,                                                          &
350        ONLY:  nspec 
351
352    USE control_parameters,                                                    &
353        ONLY:  advected_distance_x, advected_distance_y, air_chemistry,        &
354               average_count_3d, averaging_interval, averaging_interval_pr,    &
355               bc_lr_cyc, bc_ns_cyc, bc_pt_t_val,                              &
356               bc_q_t_val, call_psolver_at_all_substeps, cloud_droplets,       &
357               cloud_physics, constant_flux_layer, constant_heatflux,          &
358               create_disturbances, dopr_n, constant_diffusion, coupling_mode, &
359               coupling_start_time, current_timestep_number,                   &
360               disturbance_created, disturbance_energy_limit, dist_range,      &
361               do_sum, dt_3d, dt_averaging_input, dt_averaging_input_pr,       &
362               dt_coupling, dt_data_output_av, dt_disturb, dt_do2d_xy,         &
363               dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_domask,dt_dopts, dt_dopr,   &
364               dt_dopr_listing, dt_dots, dt_dvrp, dt_run_control, end_time,    &
365               first_call_lpm, forcing, galilei_transformation, humidity,      &
366               intermediate_timestep_count, intermediate_timestep_count_max,   &
367               land_surface, large_scale_forcing,                              &
368               loop_optimization, lsf_surf, lsf_vert, masks,                   &
369               microphysics_morrison, microphysics_seifert, mid, nest_domain,  &
370               neutral, nr_timesteps_this_run, nudging,                        &
371               ocean, passive_scalar, prho_reference, pt_reference,            &
372               pt_slope_offset, random_heatflux, rans_mode,                    &
373               rans_tke_e, run_coupled, simulated_time, simulated_time_chr,    &
374               skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,        &
375               skip_time_do3d, skip_time_domask, skip_time_dopr,               &
376               skip_time_data_output_av, sloping_surface,                      &
377               stop_dt, terminate_coupled, terminate_run, timestep_scheme,     &
378               time_coupling, time_do2d_xy, time_do2d_xz, time_do2d_yz,        &
379               time_do3d, time_domask, time_dopr, time_dopr_av,                &
380               time_dopr_listing, time_dopts, time_dosp, time_dosp_av,         &
381               time_dots, time_do_av, time_do_sla, time_disturb, time_dvrp,    &
382               time_run_control, time_since_reference_point,                   &
383               turbulent_inflow, turbulent_outflow, urban_surface,             &
384               use_initial_profile_as_reference,                               &
385               use_single_reference_value, uv_exposure, u_gtrans, v_gtrans,    &
386               virtual_flight, wind_turbine, ws_scheme_mom, ws_scheme_sca
387
388    USE cpulog,                                                                &
389        ONLY:  cpu_log, log_point, log_point_s
390
391    USE flight_mod,                                                            &
392        ONLY:  flight_measurement
393
394    USE gust_mod,                                                              &
395        ONLY:  gust_actions, gust_module_enabled
396
397    USE indices,                                                               &
398        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
399
400    USE interaction_droplets_ptq_mod,                                          &
401        ONLY:  interaction_droplets_ptq
402
403    USE interfaces
404
405    USE kinds
406
407    USE land_surface_model_mod,                                                &
408        ONLY:  lsm_boundary_condition, lsm_energy_balance, lsm_soil_model,     &
409               skip_time_do_lsm
410
411    USE lsf_nudging_mod,                                                       &
412        ONLY:  calc_tnudge, ls_forcing_surf, ls_forcing_vert, nudge_ref,       &
413               forcing_bc, forcing_bc_mass_conservation
414
415    USE netcdf_data_input_mod,                                                 &
416        ONLY:  force, netcdf_data_input_lsf
417
418    USE microphysics_mod,                                                      &
419        ONLY: collision_turbulence
420
421    USE particle_attributes,                                                   &
422        ONLY:  particle_advection, particle_advection_start,                   &
423               use_sgs_for_particles, wang_kernel
424
425    USE pegrid
426
427    USE pmc_interface,                                                         &
428        ONLY:  nested_run, nesting_mode, pmci_boundary_conds, pmci_datatrans,  &
429               pmci_ensure_nest_mass_conservation, pmci_synchronize
430
431    USE progress_bar,                                                          &
432        ONLY:  finish_progress_bar, output_progress_bar
433
434    USE prognostic_equations_mod,                                              &
435        ONLY:  prognostic_equations_cache, prognostic_equations_vector
436
437    USE radiation_model_mod,                                                   &
438        ONLY: dt_radiation, force_radiation_call, radiation, radiation_control,&
439              radiation_interaction, radiation_interactions,                   &
440              skip_time_do_radiation, time_radiation
441
442    USE spectra_mod,                                                           &
443        ONLY: average_count_sp, averaging_interval_sp, calc_spectra, dt_dosp,  &
444              skip_time_dosp
445
446    USE statistics,                                                            &
447        ONLY:  flow_statistics_called, hom, pr_palm, sums_ls_l, u_max,         &
448               u_max_ijk, v_max, v_max_ijk, w_max, w_max_ijk
449
450    USE surface_layer_fluxes_mod,                                              &
451        ONLY:  surface_layer_fluxes
452
453    USE surface_mod,                                                           &
454        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
455
456    USE turbulence_closure_mod,                                                &
457        ONLY:  tcm_diffusivities, production_e_init
458
459    USE urban_surface_mod,                                                     &
460        ONLY:  usm_boundary_condition, usm_material_heat_model,                &
461               usm_material_model,                                             &
462               usm_surface_energy_balance, usm_green_heat_model,               &
463               usm_temperature_near_surface
464
465    USE synthetic_turbulence_generator_mod,                                    &
466        ONLY:  stg_main, use_syn_turb_gen
467
468    USE user_actions_mod,                                                      &
469        ONLY:  user_actions
470
471    USE uv_exposure_model_mod,                                                 &
472        ONLY:  uvem_calc_exposure
473
474    USE wind_turbine_model_mod,                                                &
475        ONLY:  wtm_forces
476
477    USE lpm_mod,                                                               &
478        ONLY:  lpm
479
480    USE vertical_nesting_mod,                                                  &
481        ONLY:  vnested, vnest_anterpolate, vnest_anterpolate_e,                &
482               vnest_boundary_conds, vnest_boundary_conds_khkm,                & 
483               vnest_deallocate, vnest_init, vnest_init_fine,                  &
484               vnest_start_time
485
486    IMPLICIT NONE
487
488    CHARACTER (LEN=9) ::  time_to_string          !<
489    INTEGER           ::  n
490    INTEGER           ::  lsp
491
492    REAL(wp) ::  dt_3d_old  !< temporary storage of timestep to be used for
493                            !< steering of run control output interval
494!
495!-- At beginning determine the first time step
496    CALL timestep
497!
498!-- Synchronize the timestep in case of nested run.
499    IF ( nested_run )  THEN
500!
501!--    Synchronization by unifying the time step.
502!--    Global minimum of all time-steps is used for all.
503       CALL pmci_synchronize
504    ENDIF
505
506!
507!-- Determine and print out the run control quantities before the first time
508!-- step of this run. For the initial run, some statistics (e.g. divergence)
509!-- need to be determined first.
510    IF ( simulated_time == 0.0_wp )  CALL flow_statistics
511    CALL run_control
512!
513!-- Data exchange between coupled models in case that a call has been omitted
514!-- at the end of the previous run of a job chain.
515    IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled .AND. .NOT. vnested)  THEN
516!
517!--    In case of model termination initiated by the local model the coupler
518!--    must not be called because this would again cause an MPI hang.
519       DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
520          CALL surface_coupler
521          time_coupling = time_coupling - dt_coupling
522       ENDDO
523       IF (time_coupling == 0.0_wp  .AND.                                      &
524           time_since_reference_point < dt_coupling )                          &
525       THEN
526          time_coupling = time_since_reference_point
527       ENDIF
528    ENDIF
529
530#if defined( __dvrp_graphics )
531!
532!-- Time measurement with dvrp software 
533    CALL DVRP_LOG_EVENT( 2, current_timestep_number )
534#endif
535
536    CALL location_message( 'starting timestep-sequence', .TRUE. )
537!
538!-- Start of the time loop
539    DO  WHILE ( simulated_time < end_time  .AND.  .NOT. stop_dt  .AND. &
540                .NOT. terminate_run )
541
542       CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
543!
544!--    Vertical nesting: initialize fine grid
545       IF ( vnested ) THEN
546          IF ( .NOT. vnest_init  .AND.  simulated_time >= vnest_start_time )  THEN
547             CALL cpu_log( log_point(80), 'vnest_init', 'start' )
548             CALL vnest_init_fine
549             vnest_init = .TRUE.
550             CALL cpu_log( log_point(80), 'vnest_init', 'stop' )
551          ENDIF
552       ENDIF
553!
554!--    Determine ug, vg and w_subs in dependence on data from external file
555!--    LSF_DATA
556       IF ( large_scale_forcing .AND. lsf_vert )  THEN
557           CALL ls_forcing_vert ( simulated_time )
558           sums_ls_l = 0.0_wp
559       ENDIF
560
561!
562!--    Set pt_init and q_init to the current profiles taken from
563!--    NUDGING_DATA
564       IF ( nudging )  THEN
565           CALL nudge_ref ( simulated_time )
566!
567!--        Store temperature gradient at the top boundary for possible Neumann
568!--        boundary condition
569           bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
570           bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
571       ENDIF
572!
573!--    If forcing by larger-scale models is applied, check if new data
574!--    at domain boundaries need to be read.
575       IF ( forcing )  THEN
576          IF ( force%time(force%tind_p) <= simulated_time )                    &
577             CALL netcdf_data_input_lsf
578       ENDIF
579
580!
581!--    Execute the gust module actions
582       IF ( gust_module_enabled )  THEN
583          CALL gust_actions( 'before_timestep' )
584       ENDIF
585
586!
587!--    Execute the user-defined actions
588       CALL user_actions( 'before_timestep' )
589
590!
591!--    Calculate forces by wind turbines
592       IF ( wind_turbine )  THEN
593
594          CALL cpu_log( log_point(55), 'wind_turbine', 'start' )
595
596          CALL wtm_forces
597
598          CALL cpu_log( log_point(55), 'wind_turbine', 'stop' )
599
600       ENDIF       
601       
602!
603!--    Start of intermediate step loop
604       intermediate_timestep_count = 0
605       DO  WHILE ( intermediate_timestep_count < &
606                   intermediate_timestep_count_max )
607
608          intermediate_timestep_count = intermediate_timestep_count + 1
609
610!
611!--       Set the steering factors for the prognostic equations which depend
612!--       on the timestep scheme
613          CALL timestep_scheme_steering
614
615!
616!--       Calculate those variables needed in the tendency terms which need
617!--       global communication
618          IF ( .NOT. use_single_reference_value  .AND. &
619               .NOT. use_initial_profile_as_reference )  THEN
620!
621!--          Horizontally averaged profiles to be used as reference state in
622!--          buoyancy terms (WARNING: only the respective last call of
623!--          calc_mean_profile defines the reference state!)
624             IF ( .NOT. neutral )  THEN
625                CALL calc_mean_profile( pt, 4 )
626                ref_state(:)  = hom(:,1,4,0) ! this is used in the buoyancy term
627             ENDIF
628             IF ( ocean )  THEN
629                CALL calc_mean_profile( rho_ocean, 64 )
630                ref_state(:)  = hom(:,1,64,0)
631             ENDIF
632             IF ( humidity )  THEN
633                CALL calc_mean_profile( vpt, 44 )
634                ref_state(:)  = hom(:,1,44,0)
635             ENDIF
636!
637!--          Assure that ref_state does not become zero at any level
638!--          ( might be the case if a vertical level is completely occupied
639!--            with topography ).
640             ref_state = MERGE( MAXVAL(ref_state), ref_state,                  &
641                                ref_state == 0.0_wp )
642          ENDIF
643
644          IF ( .NOT. constant_diffusion )  CALL production_e_init
645          IF ( ( ws_scheme_mom .OR. ws_scheme_sca )  .AND.  &
646               intermediate_timestep_count == 1 )  CALL ws_statistics
647!
648!--       In case of nudging calculate current nudging time scale and horizontal
649!--       means of u, v, pt and q
650          IF ( nudging )  THEN
651             CALL calc_tnudge( simulated_time )
652             CALL calc_mean_profile( u, 1 )
653             CALL calc_mean_profile( v, 2 )
654             CALL calc_mean_profile( pt, 4 )
655             CALL calc_mean_profile( q, 41 )
656          ENDIF
657
658!
659!--       Solve the prognostic equations. A fast cache optimized version with
660!--       only one single loop is used in case of Piascek-Williams advection
661!--       scheme. NEC vector machines use a different version, because
662!--       in the other versions a good vectorization is prohibited due to
663!--       inlining problems.
664          IF ( loop_optimization == 'cache' )  THEN
665             CALL prognostic_equations_cache
666          ELSEIF ( loop_optimization == 'vector' )  THEN
667             CALL prognostic_equations_vector
668          ENDIF
669
670!
671!--       Particle transport/physics with the Lagrangian particle model
672!--       (only once during intermediate steps, because it uses an Euler-step)
673!--       ### particle model should be moved before prognostic_equations, in order
674!--       to regard droplet interactions directly
675          IF ( particle_advection  .AND.                         &
676               simulated_time >= particle_advection_start  .AND. &
677               intermediate_timestep_count == 1 )  THEN
678             CALL lpm
679             first_call_lpm = .FALSE.
680          ENDIF
681
682!
683!--       Interaction of droplets with temperature and specific humidity.
684!--       Droplet condensation and evaporation is calculated within
685!--       advec_particles.
686          IF ( cloud_droplets  .AND.  &
687               intermediate_timestep_count == intermediate_timestep_count_max )&
688          THEN
689             CALL interaction_droplets_ptq
690          ENDIF
691
692!
693!--       Exchange of ghost points (lateral boundary conditions)
694          CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
695
696          CALL exchange_horiz( u_p, nbgp )
697          CALL exchange_horiz( v_p, nbgp )
698          CALL exchange_horiz( w_p, nbgp )
699          CALL exchange_horiz( pt_p, nbgp )
700          IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e_p, nbgp )
701          IF ( rans_tke_e  .OR.  wang_kernel  .OR.  collision_turbulence       &
702               .OR.  use_sgs_for_particles )  THEN
703             IF ( rans_tke_e )  THEN
704                CALL exchange_horiz( diss_p, nbgp )
705             ELSE
706                CALL exchange_horiz( diss, nbgp )
707             ENDIF
708          ENDIF
709          IF ( ocean )  THEN
710             CALL exchange_horiz( sa_p, nbgp )
711             CALL exchange_horiz( rho_ocean, nbgp )
712             CALL exchange_horiz( prho, nbgp )
713          ENDIF
714          IF ( humidity )  THEN
715             CALL exchange_horiz( q_p, nbgp )
716             IF ( cloud_physics .AND. microphysics_morrison )  THEN
717                CALL exchange_horiz( qc_p, nbgp )
718                CALL exchange_horiz( nc_p, nbgp )
719             ENDIF
720             IF ( cloud_physics .AND. microphysics_seifert )  THEN
721                CALL exchange_horiz( qr_p, nbgp )
722                CALL exchange_horiz( nr_p, nbgp )
723             ENDIF
724          ENDIF
725          IF ( cloud_droplets )  THEN
726             CALL exchange_horiz( ql, nbgp )
727             CALL exchange_horiz( ql_c, nbgp )
728             CALL exchange_horiz( ql_v, nbgp )
729             CALL exchange_horiz( ql_vp, nbgp )
730          ENDIF
731          IF ( passive_scalar )  CALL exchange_horiz( s_p, nbgp )
732          IF ( air_chemistry )  THEN
733             DO  n = 1, nspec     
734                CALL exchange_horiz( chem_species(n)%conc_p, nbgp ) 
735             ENDDO
736          ENDIF
737
738          CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' )
739
740!
741!--       Boundary conditions for the prognostic quantities (except of the
742!--       velocities at the outflow in case of a non-cyclic lateral wall)
743          CALL boundary_conds
744!
745!--       Swap the time levels in preparation for the next time step.
746          CALL swap_timelevel
747
748!
749!--       Vertical nesting: Interpolate fine grid data to the coarse grid
750          IF ( vnest_init ) THEN
751             CALL cpu_log( log_point(81), 'vnest_anterpolate', 'start' )
752             CALL vnest_anterpolate
753             CALL cpu_log( log_point(81), 'vnest_anterpolate', 'stop' )
754          ENDIF
755
756          IF ( nested_run )  THEN
757
758             CALL cpu_log( log_point(60), 'nesting', 'start' )
759!
760!--          Domain nesting. The data transfer subroutines pmci_parent_datatrans
761!--          and pmci_child_datatrans are called inside the wrapper
762!--          subroutine pmci_datatrans according to the control parameters
763!--          nesting_mode and nesting_datatransfer_mode.
764!--          TO_DO: why is nesting_mode given as a parameter here?
765             CALL pmci_datatrans( nesting_mode )
766
767             IF ( TRIM( nesting_mode ) == 'two-way' .OR.                       &
768                  nesting_mode == 'vertical' )  THEN
769!
770!--             Exchange_horiz is needed for all parent-domains after the
771!--             anterpolation
772                CALL exchange_horiz( u, nbgp )
773                CALL exchange_horiz( v, nbgp )
774                CALL exchange_horiz( w, nbgp )
775                IF ( .NOT. neutral )  CALL exchange_horiz( pt, nbgp )
776
777                IF ( humidity )  THEN
778
779                   CALL exchange_horiz( q, nbgp )
780
781                   IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
782                       CALL exchange_horiz( qc, nbgp )
783                       CALL exchange_horiz( nc, nbgp )
784                   ENDIF
785                   IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
786                       CALL exchange_horiz( qr, nbgp )
787                       CALL exchange_horiz( nr, nbgp )
788                   ENDIF
789
790                ENDIF
791
792                IF ( passive_scalar )  CALL exchange_horiz( s, nbgp )
793                IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
794
795                IF ( .NOT. constant_diffusion  .AND.  rans_mode  .AND.         &
796                                                      rans_tke_e )             &
797                   CALL exchange_horiz( diss, nbgp )
798
799                IF ( air_chemistry )  THEN
800                   DO  n = 1, nspec     
801                      CALL exchange_horiz( chem_species(n)%conc, nbgp ) 
802                   ENDDO
803                ENDIF
804
805             ENDIF
806!
807!--          Set boundary conditions again after interpolation and anterpolation.
808             CALL pmci_boundary_conds
809!
810!--          Correct the w top-BC in nest domains to ensure mass conservation.
811!--          This action must never be done for the root domain. Vertical
812!--          nesting implies mass conservation.
813!--          Commented out April 18, 2018 as seemingly unnecessary.
814!--          Will later be completely removed.
815!--             IF ( nest_domain )  THEN
816!--                CALL pmci_ensure_nest_mass_conservation
817!--             ENDIF
818
819             CALL cpu_log( log_point(60), 'nesting', 'stop' )
820
821          ENDIF
822
823!
824!--       Temperature offset must be imposed at cyclic boundaries in x-direction
825!--       when a sloping surface is used
826          IF ( sloping_surface )  THEN
827             IF ( nxl ==  0 )  pt(:,:,nxlg:nxl-1) = pt(:,:,nxlg:nxl-1) - &
828                                                    pt_slope_offset
829             IF ( nxr == nx )  pt(:,:,nxr+1:nxrg) = pt(:,:,nxr+1:nxrg) + &
830                                                    pt_slope_offset
831          ENDIF
832
833!
834!--       Impose a turbulent inflow using the recycling method
835          IF ( turbulent_inflow )  CALL  inflow_turbulence
836
837!
838!--       Impose a turbulent inflow using synthetic generated turbulence
839          IF ( use_syn_turb_gen )  CALL  stg_main
840
841!
842!--       Set values at outflow boundary using the special outflow condition
843          IF ( turbulent_outflow )  CALL  outflow_turbulence
844
845!
846!--       Impose a random perturbation on the horizontal velocity field
847          IF ( create_disturbances  .AND.                                      &
848               ( call_psolver_at_all_substeps  .AND.                           &
849               intermediate_timestep_count == intermediate_timestep_count_max )&
850          .OR. ( .NOT. call_psolver_at_all_substeps  .AND.                     &
851               intermediate_timestep_count == 1 ) )                            &
852          THEN
853             time_disturb = time_disturb + dt_3d
854             IF ( time_disturb >= dt_disturb )  THEN
855                IF ( disturbance_energy_limit /= 0.0_wp  .AND.                 &
856                     hom(nzb+5,1,pr_palm,0) < disturbance_energy_limit )  THEN
857                   CALL disturb_field( 'u', tend, u )
858                   CALL disturb_field( 'v', tend, v )
859                ELSEIF ( ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )            &
860                     .AND. .NOT. nest_domain  .AND.  .NOT.  forcing )  THEN
861!
862!--                Runs with a non-cyclic lateral wall need perturbations
863!--                near the inflow throughout the whole simulation
864                   dist_range = 1
865                   CALL disturb_field( 'u', tend, u )
866                   CALL disturb_field( 'v', tend, v )
867                   dist_range = 0
868                ENDIF
869                time_disturb = time_disturb - dt_disturb
870             ENDIF
871          ENDIF
872
873!
874!--       Map forcing data derived from larger scale model onto domain
875!--       boundaries.
876          IF ( forcing  .AND.  intermediate_timestep_count ==                  &
877                               intermediate_timestep_count_max  )  THEN
878             CALL forcing_bc
879!
880!--          Moreover, ensure mass conservation
881             CALL forcing_bc_mass_conservation
882          ENDIF
883
884!
885!--       Reduce the velocity divergence via the equation for perturbation
886!--       pressure.
887          IF ( intermediate_timestep_count == 1  .OR. &
888                call_psolver_at_all_substeps )  THEN
889
890             IF (  vnest_init ) THEN
891!
892!--             Compute pressure in the CG, interpolate top boundary conditions
893!--             to the FG and then compute pressure in the FG
894                IF ( coupling_mode == 'vnested_crse' )  CALL pres
895
896                CALL cpu_log( log_point(82), 'vnest_bc', 'start' )
897                CALL vnest_boundary_conds
898                CALL cpu_log( log_point(82), 'vnest_bc', 'stop' )
899 
900                IF ( coupling_mode == 'vnested_fine' )  CALL pres
901
902!--             Anterpolate TKE, satisfy Germano Identity
903                CALL cpu_log( log_point(83), 'vnest_anter_e', 'start' )
904                CALL vnest_anterpolate_e
905                CALL cpu_log( log_point(83), 'vnest_anter_e', 'stop' )
906
907             ELSE
908
909                CALL pres
910
911             ENDIF
912
913          ENDIF
914
915!
916!--       If required, compute liquid water content
917          IF ( cloud_physics )  THEN
918             CALL calc_liquid_water_content
919          ENDIF
920!
921!--       If required, compute virtual potential temperature
922          IF ( humidity )  THEN
923             CALL compute_vpt 
924          ENDIF 
925
926!
927!--       Compute the diffusion quantities
928          IF ( .NOT. constant_diffusion )  THEN
929
930!
931!--          Determine surface fluxes shf and qsws and surface values
932!--          pt_surface and q_surface in dependence on data from external
933!--          file LSF_DATA respectively
934             IF ( ( large_scale_forcing .AND. lsf_surf ) .AND. &
935                 intermediate_timestep_count == intermediate_timestep_count_max )&
936             THEN
937                CALL ls_forcing_surf( simulated_time )
938             ENDIF
939
940!
941!--          First the vertical (and horizontal) fluxes in the surface
942!--          (constant flux) layer are computed
943             IF ( constant_flux_layer )  THEN
944                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'start' )
945                CALL surface_layer_fluxes
946                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'stop' )
947             ENDIF
948!
949!--          If required, solve the energy balance for the surface and run soil
950!--          model. Call for horizontal as well as vertical surfaces
951             IF ( land_surface .AND. time_since_reference_point >= skip_time_do_lsm)  THEN
952
953                CALL cpu_log( log_point(54), 'land_surface', 'start' )
954!
955!--             Call for horizontal upward-facing surfaces
956                CALL lsm_energy_balance( .TRUE., -1 )
957                CALL lsm_soil_model( .TRUE., -1, .TRUE. )
958!
959!--             Call for northward-facing surfaces
960                CALL lsm_energy_balance( .FALSE., 0 )
961                CALL lsm_soil_model( .FALSE., 0, .TRUE. )
962!
963!--             Call for southward-facing surfaces
964                CALL lsm_energy_balance( .FALSE., 1 )
965                CALL lsm_soil_model( .FALSE., 1, .TRUE. )
966!
967!--             Call for eastward-facing surfaces
968                CALL lsm_energy_balance( .FALSE., 2 )
969                CALL lsm_soil_model( .FALSE., 2, .TRUE. )
970!
971!--             Call for westward-facing surfaces
972                CALL lsm_energy_balance( .FALSE., 3 )
973                CALL lsm_soil_model( .FALSE., 3, .TRUE. )
974!
975!--             At the end, set boundary conditons for potential temperature
976!--             and humidity after running the land-surface model. This
977!--             might be important for the nesting, where arrays are transfered.
978                CALL lsm_boundary_condition
979
980                CALL cpu_log( log_point(54), 'land_surface', 'stop' )
981             ENDIF
982!
983!--          If required, solve the energy balance for urban surfaces and run
984!--          the material heat model
985             IF (urban_surface) THEN
986                CALL cpu_log( log_point(74), 'urban_surface', 'start' )
987                CALL usm_surface_energy_balance
988                IF ( usm_material_model )  THEN
989                   CALL usm_green_heat_model
990                   CALL usm_material_heat_model
991                ENDIF
992
993                CALL usm_temperature_near_surface
994!
995!--             At the end, set boundary conditons for potential temperature
996!--             and humidity after running the urban-surface model. This
997!--             might be important for the nesting, where arrays are transfered.
998                CALL usm_boundary_condition
999
1000                CALL cpu_log( log_point(74), 'urban_surface', 'stop' )
1001             ENDIF
1002!
1003!--          Compute the diffusion coefficients
1004             CALL cpu_log( log_point(17), 'diffusivities', 'start' )
1005             IF ( .NOT. humidity ) THEN
1006                IF ( ocean )  THEN
1007                   CALL tcm_diffusivities( prho, prho_reference )
1008                ELSE
1009                   CALL tcm_diffusivities( pt, pt_reference )
1010                ENDIF
1011             ELSE
1012                CALL tcm_diffusivities( vpt, pt_reference )
1013             ENDIF
1014             CALL cpu_log( log_point(17), 'diffusivities', 'stop' )
1015!
1016!--          Vertical nesting: set fine grid eddy viscosity top boundary condition
1017             IF ( vnest_init )  CALL vnest_boundary_conds_khkm
1018
1019          ENDIF
1020
1021!
1022!--       If required, calculate radiative fluxes and heating rates
1023          IF ( radiation .AND. intermediate_timestep_count                     &
1024               == intermediate_timestep_count_max .AND. time_since_reference_point >    &
1025               skip_time_do_radiation )  THEN
1026
1027               time_radiation = time_radiation + dt_3d
1028
1029             IF ( time_radiation >= dt_radiation .OR. force_radiation_call )   &
1030             THEN
1031
1032                CALL cpu_log( log_point(50), 'radiation', 'start' )
1033
1034                IF ( .NOT. force_radiation_call )  THEN
1035                   time_radiation = time_radiation - dt_radiation
1036                ENDIF
1037
1038                CALL radiation_control
1039
1040                CALL cpu_log( log_point(50), 'radiation', 'stop' )
1041
1042                IF ( urban_surface  .OR.  land_surface  .AND.                  &
1043                     radiation_interactions )  THEN
1044                   CALL cpu_log( log_point(75), 'radiation_interaction', 'start' )
1045                   CALL radiation_interaction
1046                   CALL cpu_log( log_point(75), 'radiation_interaction', 'stop' )
1047                ENDIF
1048
1049             ENDIF
1050          ENDIF
1051
1052       ENDDO   ! Intermediate step loop
1053!
1054!--    If required, consider chemical emissions
1055!--    (todo (FK): Implement hourly call of emissions, using time_utc from
1056!--                data_and_time_mod.f90;
1057!--                move the CALL to appropriate location)
1058       IF ( air_chemistry ) THEN
1059          CALL chem_emissions
1060       ENDIF
1061!
1062!--    If required, do UV exposure calculations
1063       IF ( uv_exposure )  THEN
1064          CALL uvem_calc_exposure
1065       ENDIF
1066!
1067!--    Increase simulation time and output times
1068       nr_timesteps_this_run      = nr_timesteps_this_run + 1
1069       current_timestep_number    = current_timestep_number + 1
1070       simulated_time             = simulated_time   + dt_3d
1071       time_since_reference_point = simulated_time - coupling_start_time
1072       simulated_time_chr         = time_to_string( time_since_reference_point )
1073
1074
1075
1076
1077       IF ( simulated_time >= skip_time_data_output_av )  THEN
1078          time_do_av         = time_do_av       + dt_3d
1079       ENDIF
1080       IF ( simulated_time >= skip_time_do2d_xy )  THEN
1081          time_do2d_xy       = time_do2d_xy     + dt_3d
1082       ENDIF
1083       IF ( simulated_time >= skip_time_do2d_xz )  THEN
1084          time_do2d_xz       = time_do2d_xz     + dt_3d
1085       ENDIF
1086       IF ( simulated_time >= skip_time_do2d_yz )  THEN
1087          time_do2d_yz       = time_do2d_yz     + dt_3d
1088       ENDIF
1089       IF ( simulated_time >= skip_time_do3d    )  THEN
1090          time_do3d          = time_do3d        + dt_3d
1091       ENDIF
1092       DO  mid = 1, masks
1093          IF ( simulated_time >= skip_time_domask(mid) )  THEN
1094             time_domask(mid)= time_domask(mid) + dt_3d
1095          ENDIF
1096       ENDDO
1097       time_dvrp          = time_dvrp        + dt_3d
1098       IF ( simulated_time >= skip_time_dosp )  THEN
1099          time_dosp       = time_dosp        + dt_3d
1100       ENDIF
1101       time_dots          = time_dots        + dt_3d
1102       IF ( .NOT. first_call_lpm )  THEN
1103          time_dopts      = time_dopts       + dt_3d
1104       ENDIF
1105       IF ( simulated_time >= skip_time_dopr )  THEN
1106          time_dopr       = time_dopr        + dt_3d
1107       ENDIF
1108       time_dopr_listing          = time_dopr_listing        + dt_3d
1109       time_run_control   = time_run_control + dt_3d
1110
1111!
1112!--    Data exchange between coupled models
1113       IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled                   &
1114                                          .AND. .NOT. vnested )  THEN
1115          time_coupling = time_coupling + dt_3d
1116
1117!
1118!--       In case of model termination initiated by the local model
1119!--       (terminate_coupled > 0), the coupler must be skipped because it would
1120!--       cause an MPI intercomminucation hang.
1121!--       If necessary, the coupler will be called at the beginning of the
1122!--       next restart run.
1123          DO WHILE ( time_coupling >= dt_coupling .AND. terminate_coupled == 0 )
1124             CALL surface_coupler
1125             time_coupling = time_coupling - dt_coupling
1126          ENDDO
1127       ENDIF
1128
1129!
1130!--    Execute the gust module actions
1131       IF ( gust_module_enabled )  THEN
1132          CALL gust_actions( 'after_integration' )
1133       ENDIF
1134
1135!
1136!--    Execute user-defined actions
1137       CALL user_actions( 'after_integration' )
1138
1139!
1140!--    If Galilei transformation is used, determine the distance that the
1141!--    model has moved so far
1142       IF ( galilei_transformation )  THEN
1143          advected_distance_x = advected_distance_x + u_gtrans * dt_3d
1144          advected_distance_y = advected_distance_y + v_gtrans * dt_3d
1145       ENDIF
1146
1147!
1148!--    Check, if restart is necessary (because cpu-time is expiring or
1149!--    because it is forced by user) and set stop flag
1150!--    This call is skipped if the remote model has already initiated a restart.
1151       IF ( .NOT. terminate_run )  CALL check_for_restart
1152
1153!
1154!--    Carry out statistical analysis and output at the requested output times.
1155!--    The MOD function is used for calculating the output time counters (like
1156!--    time_dopr) in order to regard a possible decrease of the output time
1157!--    interval in case of restart runs
1158
1159!
1160!--    Set a flag indicating that so far no statistics have been created
1161!--    for this time step
1162       flow_statistics_called = .FALSE.
1163
1164!
1165!--    If required, call flow_statistics for averaging in time
1166       IF ( averaging_interval_pr /= 0.0_wp  .AND.  &
1167            ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.  &
1168            simulated_time >= skip_time_dopr )  THEN
1169          time_dopr_av = time_dopr_av + dt_3d
1170          IF ( time_dopr_av >= dt_averaging_input_pr )  THEN
1171             do_sum = .TRUE.
1172             time_dopr_av = MOD( time_dopr_av, &
1173                                    MAX( dt_averaging_input_pr, dt_3d ) )
1174          ENDIF
1175       ENDIF
1176       IF ( do_sum )  CALL flow_statistics
1177
1178!
1179!--    Sum-up 3d-arrays for later output of time-averaged 2d/3d/masked data
1180       IF ( averaging_interval /= 0.0_wp  .AND.                                &
1181            ( dt_data_output_av - time_do_av ) <= averaging_interval  .AND. &
1182            simulated_time >= skip_time_data_output_av )                    &
1183       THEN
1184          time_do_sla = time_do_sla + dt_3d
1185          IF ( time_do_sla >= dt_averaging_input )  THEN
1186             CALL sum_up_3d_data
1187             average_count_3d = average_count_3d + 1
1188             time_do_sla = MOD( time_do_sla, MAX( dt_averaging_input, dt_3d ) )
1189          ENDIF
1190       ENDIF
1191
1192!
1193!--    Calculate spectra for time averaging
1194       IF ( averaging_interval_sp /= 0.0_wp  .AND.  &
1195            ( dt_dosp - time_dosp ) <= averaging_interval_sp  .AND.  &
1196            simulated_time >= skip_time_dosp )  THEN
1197          time_dosp_av = time_dosp_av + dt_3d
1198          IF ( time_dosp_av >= dt_averaging_input_pr )  THEN
1199             CALL calc_spectra
1200             time_dosp_av = MOD( time_dosp_av, &
1201                                 MAX( dt_averaging_input_pr, dt_3d ) )
1202          ENDIF
1203       ENDIF
1204
1205!
1206!--    Call flight module and output data
1207       IF ( virtual_flight )  THEN
1208          CALL flight_measurement
1209          CALL data_output_flight
1210       ENDIF
1211
1212!
1213!--    Profile output (ASCII) on file
1214       IF ( time_dopr_listing >= dt_dopr_listing )  THEN
1215          CALL print_1d
1216          time_dopr_listing = MOD( time_dopr_listing, MAX( dt_dopr_listing, &
1217                                                           dt_3d ) )
1218       ENDIF
1219
1220!
1221!--    Graphic output for PROFIL
1222       IF ( time_dopr >= dt_dopr )  THEN
1223          IF ( dopr_n /= 0 )  CALL data_output_profiles
1224          time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
1225          time_dopr_av = 0.0_wp    ! due to averaging (see above)
1226       ENDIF
1227
1228!
1229!--    Graphic output for time series
1230       IF ( time_dots >= dt_dots )  THEN
1231          CALL data_output_tseries
1232          time_dots = MOD( time_dots, MAX( dt_dots, dt_3d ) )
1233       ENDIF
1234
1235!
1236!--    Output of spectra (formatted for use with PROFIL), in case of no
1237!--    time averaging, spectra has to be calculated before
1238       IF ( time_dosp >= dt_dosp )  THEN
1239          IF ( average_count_sp == 0 )  CALL calc_spectra
1240          CALL data_output_spectra
1241          time_dosp = MOD( time_dosp, MAX( dt_dosp, dt_3d ) )
1242       ENDIF
1243
1244!
1245!--    2d-data output (cross-sections)
1246       IF ( time_do2d_xy >= dt_do2d_xy )  THEN
1247          CALL data_output_2d( 'xy', 0 )
1248          time_do2d_xy = MOD( time_do2d_xy, MAX( dt_do2d_xy, dt_3d ) )
1249       ENDIF
1250       IF ( time_do2d_xz >= dt_do2d_xz )  THEN
1251          CALL data_output_2d( 'xz', 0 )
1252          time_do2d_xz = MOD( time_do2d_xz, MAX( dt_do2d_xz, dt_3d ) )
1253       ENDIF
1254       IF ( time_do2d_yz >= dt_do2d_yz )  THEN
1255          CALL data_output_2d( 'yz', 0 )
1256          time_do2d_yz = MOD( time_do2d_yz, MAX( dt_do2d_yz, dt_3d ) )
1257       ENDIF
1258
1259!
1260!--    3d-data output (volume data)
1261       IF ( time_do3d >= dt_do3d )  THEN
1262          CALL data_output_3d( 0 )
1263          time_do3d = MOD( time_do3d, MAX( dt_do3d, dt_3d ) )
1264       ENDIF
1265
1266!
1267!--    Masked data output
1268       DO  mid = 1, masks
1269          IF ( time_domask(mid) >= dt_domask(mid) )  THEN
1270             CALL data_output_mask( 0 )
1271             time_domask(mid) = MOD( time_domask(mid),  &
1272                                     MAX( dt_domask(mid), dt_3d ) )
1273          ENDIF
1274       ENDDO
1275
1276!
1277!--    Output of time-averaged 2d/3d/masked data
1278       IF ( time_do_av >= dt_data_output_av )  THEN
1279          CALL average_3d_data
1280          CALL data_output_2d( 'xy', 1 )
1281          CALL data_output_2d( 'xz', 1 )
1282          CALL data_output_2d( 'yz', 1 )
1283          CALL data_output_3d( 1 )
1284          DO  mid = 1, masks
1285             CALL data_output_mask( 1 )
1286          ENDDO
1287          time_do_av = MOD( time_do_av, MAX( dt_data_output_av, dt_3d ) )
1288       ENDIF
1289
1290!
1291!--    Output of particle time series
1292       IF ( particle_advection )  THEN
1293          IF ( time_dopts >= dt_dopts  .OR. &
1294               ( simulated_time >= particle_advection_start  .AND. &
1295                 first_call_lpm ) )  THEN
1296             CALL data_output_ptseries
1297             time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
1298          ENDIF
1299       ENDIF
1300
1301!
1302!--    Output of dvrp-graphics (isosurface, particles, slicer)
1303#if defined( __dvrp_graphics )
1304       CALL DVRP_LOG_EVENT( -2, current_timestep_number-1 )
1305#endif
1306       IF ( time_dvrp >= dt_dvrp )  THEN
1307          CALL data_output_dvrp
1308          time_dvrp = MOD( time_dvrp, MAX( dt_dvrp, dt_3d ) )
1309       ENDIF
1310#if defined( __dvrp_graphics )
1311       CALL DVRP_LOG_EVENT( 2, current_timestep_number )
1312#endif
1313
1314!
1315!--    If required, set the heat flux for the next time step at a random value
1316       IF ( constant_heatflux  .AND.  random_heatflux )  THEN
1317          IF ( surf_def_h(0)%ns >= 1 )  CALL disturb_heatflux( surf_def_h(0) )
1318          IF ( surf_lsm_h%ns    >= 1 )  CALL disturb_heatflux( surf_lsm_h    )
1319          IF ( surf_usm_h%ns    >= 1 )  CALL disturb_heatflux( surf_usm_h    )
1320       ENDIF
1321
1322!
1323!--    Execute the gust module actions
1324       IF ( gust_module_enabled )  THEN
1325          CALL gust_actions( 'after_timestep' )
1326       ENDIF
1327
1328!
1329!--    Execute user-defined actions
1330       CALL user_actions( 'after_timestep' )
1331
1332!
1333!--    Determine size of next time step. Save timestep dt_3d because it is
1334!--    newly calculated in routine timestep, but required further below for
1335!--    steering the run control output interval
1336       dt_3d_old = dt_3d
1337       CALL timestep
1338
1339!
1340!--    Synchronize the timestep in case of nested run.
1341       IF ( nested_run )  THEN
1342!
1343!--       Synchronize by unifying the time step.
1344!--       Global minimum of all time-steps is used for all.
1345          CALL pmci_synchronize
1346       ENDIF
1347
1348!
1349!--    Computation and output of run control parameters.
1350!--    This is also done whenever perturbations have been imposed
1351       IF ( time_run_control >= dt_run_control  .OR.                     &
1352            timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created ) &
1353       THEN
1354          CALL run_control
1355          IF ( time_run_control >= dt_run_control )  THEN
1356             time_run_control = MOD( time_run_control, &
1357                                     MAX( dt_run_control, dt_3d_old ) )
1358          ENDIF
1359       ENDIF
1360
1361!
1362!--    Output elapsed simulated time in form of a progress bar on stdout
1363       IF ( myid == 0 )  CALL output_progress_bar
1364
1365       CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
1366
1367
1368    ENDDO   ! time loop
1369
1370!-- Vertical nesting: Deallocate variables initialized for vertical nesting   
1371    IF ( vnest_init )  CALL vnest_deallocate
1372
1373    IF ( myid == 0 )  CALL finish_progress_bar
1374
1375#if defined( __dvrp_graphics )
1376    CALL DVRP_LOG_EVENT( -2, current_timestep_number )
1377#endif
1378
1379    CALL location_message( 'finished time-stepping', .TRUE. )
1380
1381 END SUBROUTINE time_integration
Note: See TracBrowser for help on using the repository browser.