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

Last change on this file since 3285 was 3274, checked in by knoop, 6 years ago

Modularization of all bulk cloud physics code components

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