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

Last change on this file since 4500 was 4472, checked in by Giersch, 5 years ago

Profile output of the Kolmogorov length scale added

  • Property svn:keywords set to Id
File size: 72.9 KB
RevLine 
[1682]1!> @file time_integration.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1036]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!
[4360]17! Copyright 1997-2020 Leibniz Universitaet Hannover
[2000]18!------------------------------------------------------------------------------!
[1036]19!
[484]20! Current revisions:
[1092]21! ------------------
[4472]22!
23!
[1366]24! Former revisions:
25! -----------------
26! $Id: time_integration.f90 4472 2020-03-24 12:21:00Z suehring $
[4472]27! OPENACC COPYIN directive for ddx and ddy added
28!
29! 4466 2020-03-20 16:14:41Z suehring
[4466]30! Add advection fluxes to ACC copyin
31!
32! 4457 2020-03-11 14:20:43Z raasch
[4457]33! use statement for exchange horiz added
[4466]34!
[4457]35! 4444 2020-03-05 15:59:50Z raasch
[4444]36! bugfix: cpp-directives for serial mode added
[4466]37!
[4444]38! 4420 2020-02-24 14:13:56Z maronga
[4420]39! Added output control for wind turbine model
[4466]40!
[4420]41! 4403 2020-02-12 13:08:46Z banzhafs
[4403]42! Allowing both existing and on-demand emission read modes
43!
44! 4360 2020-01-07 11:25:50Z suehring
[4356]45! Bugfix, hour_call_emis uninitialized at first call of time_integration
[4466]46!
[4356]47! 4346 2019-12-18 11:55:56Z motisi
[4346]48! Introduction of wall_flags_total_0, which currently sets bits based on static
49! topography information used in wall_flags_static_0
[4466]50!
[4346]51! 4329 2019-12-10 15:46:36Z motisi
[4329]52! Renamed wall_flags_0 to wall_flags_static_0
[4466]53!
[4329]54! 4281 2019-10-29 15:15:39Z schwenkel
[4281]55! Moved boundary conditions to module interface
[4466]56!
[4281]57! 4276 2019-10-28 16:03:29Z schwenkel
[4276]58! Further modularization of lpm code components
[4466]59!
[4276]60! 4275 2019-10-28 15:34:55Z schwenkel
[4275]61! Move call oft lpm to the end of intermediate timestep loop
[4276]62!
[4275]63! 4268 2019-10-17 11:29:38Z schwenkel
[4268]64! Removing module specific boundary conditions an put them into their modules
[4276]65!
[4268]66! 4227 2019-09-10 18:04:34Z gronemeier
[4227]67! implement new palm_date_time_mod
[4466]68!
[4227]69! 4226 2019-09-10 17:03:24Z suehring
[4226]70! Changes in interface for the offline nesting
[4466]71!
[4226]72! 4182 2019-08-22 15:20:23Z scharf
[4182]73! Corrected "Former revisions" section
[4466]74!
[4182]75! 4170 2019-08-19 17:12:31Z gronemeier
[4170]76! copy diss, diss_p, tdiss_m to GPU
[4466]77!
[4170]78! 4144 2019-08-06 09:11:47Z raasch
[4144]79! relational operators .EQ., .NE., etc. replaced by ==, /=, etc.
[4466]80!
[4144]81! 4126 2019-07-30 11:09:11Z gronemeier
[4126]82! renamed routine to calculate uv exposure
[4466]83!
[4126]84! 4111 2019-07-22 18:16:57Z suehring
[4111]85! advc_flags_1 / advc_flags_2 renamed to advc_flags_m / advc_flags_s
[4466]86!
[4111]87! 4069 2019-07-01 14:05:51Z Giersch
[4466]88! Masked output running index mid has been introduced as a local variable to
[4069]89! avoid runtime error (Loop variable has been modified) in time_integration
[4466]90!
[4069]91! 4064 2019-07-01 05:33:33Z gronemeier
[4064]92! Moved call to radiation module out of intermediate time loop
[4466]93!
[4064]94! 4048 2019-06-21 21:00:21Z knoop
[4048]95! Moved production_e_init call into turbulence_closure_mod
[4466]96!
[4048]97! 4047 2019-06-21 18:58:09Z knoop
[4047]98! Added remainings of swap_timelevel upon its dissolution
[4466]99!
[4047]100! 4043 2019-06-18 16:59:00Z schwenkel
[4043]101! Further LPM modularization
102!
103! 4039 2019-06-18 10:32:41Z suehring
[4039]104! Rename subroutines in module for diagnostic quantities
[4466]105!
[4039]106! 4029 2019-06-14 14:04:35Z raasch
[4029]107! exchange of ghost points and boundary conditions separated for chemical species and SALSA module,
108! bugfix: decycling of chemistry species after nesting data transfer
[4466]109!
[4029]110! 4022 2019-06-12 11:52:39Z suehring
[4022]111! Call synthetic turbulence generator at last RK3 substep right after boundary
[4466]112! conditions are updated in offline nesting in order to assure that
113! perturbations are always imposed
114!
[4022]115! 4017 2019-06-06 12:16:46Z schwenkel
[4010]116! Mass (volume) flux correction included to ensure global mass conservation for child domains.
[4466]117!
[4010]118! 3994 2019-05-22 18:08:09Z suehring
[3994]119! output of turbulence intensity added
[4466]120!
[3994]121! 3988 2019-05-22 11:32:37Z kanani
[3988]122! Implement steerable output interval for virtual measurements
[4466]123!
[3988]124! 3968 2019-05-13 11:04:01Z suehring
[3968]125! replace nspec_out with n_matched_vars
[4466]126!
[3968]127! 3929 2019-04-24 12:52:08Z banzhafs
[3929]128! Reverse changes back from revision 3878: use chem_boundary_conds instead of
129! chem_boundary_conds_decycle
[4466]130!
131!
[3929]132! 3885 2019-04-11 11:29:34Z kanani
[4466]133! Changes related to global restructuring of location messages and introduction
[3885]134! of additional debug messages
[3929]135!
[3885]136! 3879 2019-04-08 20:25:23Z knoop
[3875]137! Moved wtm_forces to module_interface_actions
[4466]138!
[3875]139! 3872 2019-04-08 15:03:06Z knoop
[3864]140! Modifications made for salsa:
141! - Call salsa_emission_update at each time step but do the checks within
142!   salsa_emission_update (i.e. skip_time_do_salsa >= time_since_reference_point
143!   and next_aero_emission_update <= time_since_reference_point ).
[4466]144! - Renamed nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and
[3864]145!   ngast --> ngases_salsa and loop indices b, c and sg to ib, ic and ig
146! - Apply nesting for salsa variables
147! - Removed cpu_log calls speciffic for salsa.
[4466]148!
[3864]149! 3833 2019-03-28 15:04:04Z forkel
[3879]150! added USE chem_gasphase_mod, replaced nspec by nspec since fixed compounds are not integrated
[4466]151!
[3833]152! 3820 2019-03-27 11:53:41Z forkel
[3820]153! renamed do_emiss to emissions_anthropogenic (ecc)
[4466]154!
155!
[3820]156! 3774 2019-03-04 10:52:49Z moh.hefny
[3774]157! rephrase if statement to avoid unallocated array in case of
158! nesting_offline is false (crashing during debug mode)
159!
160! 3761 2019-02-25 15:31:42Z raasch $
[3761]161! module section re-formatted and openacc required variables moved to separate section,
162! re-formatting to 100 char line width
[4466]163!
[3761]164! 3745 2019-02-15 18:57:56Z suehring
[3745]165! Call indoor model after first timestep
[4466]166!
[3745]167! 3744 2019-02-15 18:38:58Z suehring
[3742]168! - Moved call of bio_calculate_thermal_index_maps from biometeorology module to
169! time_integration to make sure averaged input is updated before calculating.
[4466]170!
[3742]171! 3739 2019-02-13 08:05:17Z dom_dwd_user
[3739]172! Removed everything related to "time_bio_results" as this is never used.
[4466]173!
[3739]174! 3724 2019-02-06 16:28:23Z kanani
[4466]175! Correct double-used log_point_s unit
176!
[3724]177! 3719 2019-02-06 13:10:18Z kanani
[3719]178! - removed wind_turbine cpu measurement, since same time is measured inside
179!   wtm_forces subroutine as special measures
180! - moved the numerous vnest cpulog to special measures
181! - extended radiation cpulog over entire radiation part,
182!   moved radiation_interactions cpulog to special measures
183! - moved some cpu_log calls to this routine for better overview
[4466]184!
[3719]185! 3705 2019-01-29 19:56:39Z suehring
[3705]186! Data output for virtual measurements added
[4466]187!
[3705]188! 3704 2019-01-29 19:51:41Z suehring
[3648]189! Rename subroutines for surface-data output
[4466]190!
[3648]191! 3647 2019-01-02 14:10:44Z kanani
[3647]192! Bugfix: add time_since_reference_point to IF clause for data_output calls
193! (otherwise skip_time_* values don't come into affect with dt_do* = 0.0).
194! Clean up indoor_model and biometeorology model call.
[3569]195!
[4182]196! Revision 1.1  1997/08/11 06:19:04  raasch
197! Initial revision
198!
199!
[1]200! Description:
201! ------------
[1682]202!> Integration in time of the model equations, statistical analysis and graphic
203!> output
[1]204!------------------------------------------------------------------------------!
[1682]205 SUBROUTINE time_integration
[1]206
[4466]207
[3761]208    USE advec_ws,                                                                                  &
[1320]209        ONLY:  ws_statistics
210
[3761]211    USE arrays_3d,                                                                                 &
[4444]212        ONLY:  diss, diss_p, dzu, e_p, nc_p, nr_p, prho, pt, pt_p, pt_init, q, qc_p, qr_p, q_init, &
213               q_p, ref_state, rho_ocean, sa_p, s_p, tend, u, u_p, v, vpt, v_p, w_p
[1320]214
[4444]215#if defined( __parallel )  &&  ! defined( _OPENACC )
216    USE arrays_3d,                                                                                 &
217        ONLY:  e, nc, nr, qc, qr, s, w
218#endif
219
[3761]220    USE biometeorology_mod,                                                                        &
[4126]221        ONLY:  bio_calculate_thermal_index_maps, thermal_comfort, bio_calculate_uv_exposure,       &
222               uv_exposure
[3448]223
[3761]224    USE bulk_cloud_model_mod,                                                                      &
225        ONLY: bulk_cloud_model, calc_liquid_water_content, collision_turbulence,                   &
226              microphysics_morrison, microphysics_seifert
[3294]227
[3761]228    USE calc_mean_profile_mod,                                                                     &
[1320]229        ONLY:  calc_mean_profile
230
[3761]231    USE chem_emissions_mod,                                                                        &
[4403]232        ONLY:  chem_emissions_setup, chem_emissions_update_on_demand
[2696]233
[3833]234    USE chem_gasphase_mod,                                                                         &
[3929]235        ONLY:  nvar
[3833]236
[3761]237    USE chem_modules,                                                                              &
[4444]238        ONLY:  bc_cs_t_val, chem_species, emissions_anthropogenic, emiss_read_legacy_mode,         &
[4403]239               n_matched_vars
[2696]240
[4444]241#if defined( __parallel )
242    USE chem_modules,                                                                              &
243        ONLY:  cs_name
244#endif
245
[3761]246    USE chemistry_model_mod,                                                                       &
[3929]247        ONLY:  chem_boundary_conds
[3298]248
[3761]249    USE control_parameters,                                                                        &
250        ONLY:  advected_distance_x, advected_distance_y, air_chemistry, average_count_3d,          &
251               averaging_interval, averaging_interval_pr, bc_lr_cyc, bc_ns_cyc, bc_pt_t_val,       &
252               bc_q_t_val, biometeorology, call_psolver_at_all_substeps,  child_domain,            &
[4276]253               constant_flux_layer, constant_heatflux, create_disturbances,        &
[3761]254               dopr_n, constant_diffusion, coupling_mode, coupling_start_time,                     &
255               current_timestep_number, disturbance_created, disturbance_energy_limit, dist_range, &
256               do_sum, dt_3d, dt_averaging_input, dt_averaging_input_pr, dt_coupling,              &
257               dt_data_output_av, dt_disturb, dt_do2d_xy, dt_do2d_xz, dt_do2d_yz, dt_do3d,         &
[4017]258               dt_domask,dt_dopts, dt_dopr, dt_dopr_listing, dt_dots, dt_run_control,              &
[3761]259               end_time, first_call_lpm, first_call_mas, galilei_transformation, humidity,         &
260               indoor_model, intermediate_timestep_count, intermediate_timestep_count_max,         &
261               land_surface, large_scale_forcing, loop_optimization, lsf_surf, lsf_vert, masks,    &
[4069]262               multi_agent_system_end, multi_agent_system_start, nesting_offline, neutral,         &
[3761]263               nr_timesteps_this_run, nudging, ocean_mode, passive_scalar, pt_reference,           &
[4444]264               pt_slope_offset, random_heatflux, rans_tke_e, run_coupled, salsa,                   &
[3761]265               simulated_time, simulated_time_chr, skip_time_do2d_xy, skip_time_do2d_xz,           &
266               skip_time_do2d_yz, skip_time_do3d, skip_time_domask, skip_time_dopr,                &
267               skip_time_data_output_av, sloping_surface, stop_dt, surface_output,                 &
268               terminate_coupled, terminate_run, timestep_scheme, time_coupling, time_do2d_xy,     &
269               time_do2d_xz, time_do2d_yz, time_do3d, time_domask, time_dopr, time_dopr_av,        &
270               time_dopr_listing, time_dopts, time_dosp, time_dosp_av, time_dots, time_do_av,      &
[4017]271               time_do_sla, time_disturb, time_run_control, time_since_reference_point,            &
[3761]272               turbulent_inflow, turbulent_outflow, urban_surface,                                 &
273               use_initial_profile_as_reference, use_single_reference_value, u_gtrans, v_gtrans,   &
[4047]274               virtual_flight, virtual_measurement, ws_scheme_mom, ws_scheme_sca, timestep_count
[1320]275
[4444]276#if defined( __parallel )
277    USE control_parameters,                                                                        &
278        ONLY:  rans_mode
279#endif
280
[3761]281    USE cpulog,                                                                                    &
[1320]282        ONLY:  cpu_log, log_point, log_point_s
283
[3994]284    USE diagnostic_output_quantities_mod,                                                          &
[4039]285        ONLY:  doq_calculate,                                                                      &
[3994]286               timestep_number_at_prev_calc
287
[4457]288    USE exchange_horiz_mod,                                                                        &
289        ONLY:  exchange_horiz
290
[3761]291    USE flight_mod,                                                                                &
[1957]292        ONLY:  flight_measurement
293
[4472]294    USE grid_variables,                                                                            &
295        ONLY:  ddx, ddy
296
[3761]297    USE indices,                                                                                   &
298        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, nzb, nzt
[1320]299
[3761]300    USE indoor_model_mod,                                                                          &
301        ONLY:  dt_indoor, im_main_heatcool, time_indoor
[3469]302
[1918]303    USE interfaces
304
[1320]305    USE kinds
306
[3761]307    USE land_surface_model_mod,                                                                    &
308        ONLY:  lsm_boundary_condition, lsm_energy_balance, lsm_soil_model, skip_time_do_lsm
[1496]309
[4017]310    USE lagrangian_particle_model_mod,                                                             &
[4276]311        ONLY:  lpm_data_output_ptseries
[3761]312
313    USE lsf_nudging_mod,                                                                           &
[3347]314        ONLY:  calc_tnudge, ls_forcing_surf, ls_forcing_vert, nudge_ref
[1320]315
[3761]316    USE module_interface,                                                                          &
[4268]317        ONLY:  module_interface_actions, module_interface_swap_timelevel,                          &
318               module_interface_boundary_conditions
[3684]319
[3761]320    USE multi_agent_system_mod,                                                                    &
[3198]321        ONLY:  agents_active, multi_agent_system
[3448]322
[3761]323    USE nesting_offl_mod,                                                                          &
[4226]324        ONLY:  nesting_offl_bc,                                                                    &
325               nesting_offl_geostrophic_wind,                                                      &
326               nesting_offl_input,                                                                 &
327               nesting_offl_interpolation_factor,                                                  &
328               nesting_offl_mass_conservation
[3864]329
[3761]330    USE netcdf_data_input_mod,                                                                     &
[4226]331        ONLY:  chem_emis, chem_emis_att
[3298]332
[3761]333    USE ocean_mod,                                                                                 &
[3294]334        ONLY:  prho_reference
335
[4227]336    USE palm_date_time_mod,                                                                        &
337        ONLY:  get_date_time
338
[3761]339    USE particle_attributes,                                                                       &
340        ONLY:  particle_advection, particle_advection_start, use_sgs_for_particles, wang_kernel
[1320]341
[1]342    USE pegrid
343
[4444]344#if defined( __parallel )
[3761]345    USE pmc_interface,                                                                             &
[4010]346        ONLY:  nested_run, nesting_mode, pmci_boundary_conds, pmci_datatrans, pmci_synchronize,    &
[4047]347        pmci_ensure_nest_mass_conservation, pmci_ensure_nest_mass_conservation_vertical,           &
348        pmci_set_swaplevel
[4444]349#endif
[1762]350
[3761]351    USE progress_bar,                                                                              &
[1402]352        ONLY:  finish_progress_bar, output_progress_bar
353
[3761]354    USE prognostic_equations_mod,                                                                  &
[2118]355        ONLY:  prognostic_equations_cache, prognostic_equations_vector
[1320]356
[3761]357    USE radiation_model_mod,                                                                       &
358        ONLY: dt_radiation, force_radiation_call, radiation, radiation_control,                    &
359              radiation_interaction, radiation_interactions, skip_time_do_radiation, time_radiation
[3864]360
[3761]361    USE salsa_mod,                                                                                 &
[3864]362        ONLY: aerosol_number, aerosol_mass, bc_am_t_val, bc_an_t_val, bc_gt_t_val,                 &
363              nbins_aerosol, ncomponents_mass, ngases_salsa, salsa_boundary_conds,                 &
364              salsa_emission_update, salsa_gas, salsa_gases_from_chem, skip_time_do_salsa
[1496]365
[3761]366    USE spectra_mod,                                                                               &
367        ONLY: average_count_sp, averaging_interval_sp, calc_spectra, dt_dosp, skip_time_dosp
[1786]368
[3761]369    USE statistics,                                                                                &
370        ONLY:  flow_statistics_called, hom, pr_palm, sums_ls_l
[1320]371
[3761]372
373    USE surface_layer_fluxes_mod,                                                                  &
[1691]374        ONLY:  surface_layer_fluxes
375
[3761]376    USE surface_data_output_mod,                                                                   &
377        ONLY:  average_count_surf, averaging_interval_surf, dt_dosurf, dt_dosurf_av,               &
378               surface_data_output, surface_data_output_averaging, skip_time_dosurf,               &
[3648]379               skip_time_dosurf_av, time_dosurf, time_dosurf_av
[2232]380
[3761]381    USE surface_mod,                                                                               &
382        ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
383
384    USE synthetic_turbulence_generator_mod,                                                        &
385        ONLY:  dt_stg_call, dt_stg_adjust, parametrize_inflow_turbulence, stg_adjust, stg_main,    &
386               time_stg_adjust, time_stg_call, use_syn_turb_gen
387
388    USE turbulence_closure_mod,                                                                    &
[4048]389        ONLY:  tcm_diffusivities
[2696]390
[3761]391    USE urban_surface_mod,                                                                         &
392        ONLY:  usm_boundary_condition, usm_material_heat_model, usm_material_model,                &
[3597]393               usm_surface_energy_balance, usm_green_heat_model
[2007]394
[3761]395    USE vertical_nesting_mod,                                                                      &
[4444]396        ONLY:  vnested, vnest_init
[3864]397
[4444]398#if defined( __parallel )
399    USE vertical_nesting_mod,                                                                      &
400        ONLY:  vnest_anterpolate, vnest_anterpolate_e, vnest_boundary_conds,                       &
401               vnest_boundary_conds_khkm, vnest_deallocate, vnest_init_fine, vnest_start_time
402#endif
403
[3761]404    USE virtual_measurement_mod,                                                                   &
[3988]405        ONLY:  dt_virtual_measurement,                                                             &
406               time_virtual_measurement,                                                           &
407               vm_data_output,                                                                     &
408               vm_sampling,                                                                        &
409               vm_time_start
[2259]410
[4466]411
[4420]412    USE wind_turbine_model_mod,                                                                    &
413        ONLY:  dt_data_output_wtm, time_wtm, wind_turbine, wtm_data_output
[1914]414
[3761]415#if defined( _OPENACC )
[4444]416    USE arrays_3d,                                                                                 &
[4466]417        ONLY:  d, dd2zu, ddzu, ddzw,                                                               &
418               diss_l_u,                                                                           &
419               diss_l_v,                                                                           &
420               diss_l_w,                                                                           &
421               diss_s_u,                                                                           &
422               diss_s_v,                                                                           &
423               diss_s_w,                                                                           &
424               drho_air, drho_air_zw, dzw, e,                                                      &
425               flux_l_u,                                                                           &
426               flux_l_v,                                                                           &
427               flux_l_w,                                                                           &
428               flux_s_u,                                                                           &
429               flux_s_v,                                                                           &
430               flux_s_w,                                                                           &
431               heatflux_output_conversion,                                                         &
[4444]432               kh, km, momentumflux_output_conversion, nc, nr, p, ptdf_x, ptdf_y, qc, qr, rdf,     &
433               rdf_sc, rho_air, rho_air_zw, s, tdiss_m, te_m, tpt_m, tu_m, tv_m, tw_m, ug, u_init, &
434               u_stokes_zu, vg, v_init, v_stokes_zu, w, zu
[2365]435
[3761]436    USE control_parameters,                                                                        &
437        ONLY:  tsc
438
439    USE indices,                                                                                   &
[4346]440        ONLY:  advc_flags_m, advc_flags_s, nyn, nyng, nys, nysg, nz, nzb_max, wall_flags_total_0
[3761]441
442    USE statistics,                                                                                &
443        ONLY:  rmask, statistic_regions, sums_l, sums_l_l, sums_us2_ws_l,                          &
444               sums_wsus_ws_l, sums_vs2_ws_l, sums_wsvs_ws_l, sums_ws2_ws_l, sums_wspts_ws_l,      &
445               sums_wsqs_ws_l, sums_wssas_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l, sums_wsncs_ws_l, &
[3872]446               sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l
[3761]447
448    USE surface_mod,                                                                               &
449        ONLY:  bc_h, enter_surface_arrays, exit_surface_arrays
450#endif
451
452
[1]453    IMPLICIT NONE
454
[3298]455    CHARACTER (LEN=9) ::  time_to_string   !<
[3864]456
[4356]457    INTEGER(iwp) ::  hour                !< hour of current time
458    INTEGER(iwp) ::  hour_call_emis = -1 !< last hour where emission was called
459    INTEGER(iwp) ::  ib                  !< index for aerosol size bins
460    INTEGER(iwp) ::  ic                  !< index for aerosol mass bins
461    INTEGER(iwp) ::  icc                 !< additional index for aerosol mass bins
462    INTEGER(iwp) ::  ig                  !< index for salsa gases
463    INTEGER(iwp) ::  lsp                 !<
[4444]464    INTEGER(iwp) ::  mid                 !< masked output running index
465#if defined( __parallel )
[4356]466    INTEGER(iwp) ::  lsp_usr             !<
467    INTEGER(iwp) ::  n                   !< loop counter for chemistry species
[4444]468#endif
[3014]469
[1918]470    REAL(wp) ::  dt_3d_old  !< temporary storage of timestep to be used for
471                            !< steering of run control output interval
[3241]472    REAL(wp) ::  time_since_reference_point_save  !< original value of
473                                                  !< time_since_reference_point
474
[3634]475
[3761]476!
477!-- Copy data from arrays_3d
[4466]478!$ACC DATA &
[3634]479!$ACC COPY(d(nzb+1:nzt,nys:nyn,nxl:nxr)) &
[4170]480!$ACC COPY(diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
[3634]481!$ACC COPY(e(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
482!$ACC COPY(u(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
483!$ACC COPY(v(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
484!$ACC COPY(w(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
485!$ACC COPY(kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
486!$ACC COPY(km(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
487!$ACC COPY(p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
488!$ACC COPY(pt(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
489
490!$ACC DATA &
[4466]491!$ACC COPYIN(diss_l_u(0:nz+1,nys:nyn,0), flux_l_u(0:nz+1,nys:nyn,0)) &
492!$ACC COPYIN(diss_l_v(0:nz+1,nys:nyn,0), flux_l_v(0:nz+1,nys:nyn,0)) &
493!$ACC COPYIN(diss_l_w(0:nz+1,nys:nyn,0), flux_l_w(0:nz+1,nys:nyn,0)) &
494!$ACC COPYIN(diss_s_u(0:nz+1,0), flux_s_u(0:nz+1,0)) &
495!$ACC COPYIN(diss_s_v(0:nz+1,0), flux_s_v(0:nz+1,0)) &
496!$ACC COPYIN(diss_s_w(0:nz+1,0), flux_s_w(0:nz+1,0)) &
[4170]497!$ACC COPY(diss_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
[3634]498!$ACC COPY(e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
499!$ACC COPY(u_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
500!$ACC COPY(v_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
501!$ACC COPY(w_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
502!$ACC COPY(pt_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
503!$ACC COPY(tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
[4170]504!$ACC COPY(tdiss_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
[3634]505!$ACC COPY(te_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
506!$ACC COPY(tu_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
507!$ACC COPY(tv_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
508!$ACC COPY(tw_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
509!$ACC COPY(tpt_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
510
511!$ACC DATA &
512!$ACC COPYIN(rho_air(nzb:nzt+1), drho_air(nzb:nzt+1)) &
513!$ACC COPYIN(rho_air_zw(nzb:nzt+1), drho_air_zw(nzb:nzt+1)) &
514!$ACC COPYIN(zu(nzb:nzt+1)) &
515!$ACC COPYIN(dzu(1:nzt+1), dzw(1:nzt+1)) &
516!$ACC COPYIN(ddzu(1:nzt+1), dd2zu(1:nzt)) &
517!$ACC COPYIN(ddzw(1:nzt+1)) &
[3658]518!$ACC COPYIN(heatflux_output_conversion(nzb:nzt+1)) &
519!$ACC COPYIN(momentumflux_output_conversion(nzb:nzt+1)) &
[3634]520!$ACC COPYIN(rdf(nzb+1:nzt), rdf_sc(nzb+1:nzt)) &
521!$ACC COPYIN(ptdf_x(nxlg:nxrg), ptdf_y(nysg:nyng)) &
522!$ACC COPYIN(ref_state(0:nz+1)) &
523!$ACC COPYIN(u_init(0:nz+1), v_init(0:nz+1)) &
524!$ACC COPYIN(u_stokes_zu(nzb:nzt+1), v_stokes_zu(nzb:nzt+1)) &
525!$ACC COPYIN(pt_init(0:nz+1)) &
526!$ACC COPYIN(ug(0:nz+1), vg(0:nz+1))
527
[3761]528!
529!-- Copy data from control_parameters
[3634]530!$ACC DATA &
531!$ACC COPYIN(tsc(1:5))
532
[3761]533!
[4472]534!-- Copy data from grid_variables
535!$ACC DATA &
536!$ACC COPYIN(ddx, ddy)
537
538!
[3761]539!-- Copy data from indices
[3634]540!$ACC DATA &
[4111]541!$ACC COPYIN(advc_flags_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
542!$ACC COPYIN(advc_flags_s(nzb:nzt+1,nysg:nyng,nxlg:nxrg)) &
[4346]543!$ACC COPYIN(wall_flags_total_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg))
[3634]544
[3761]545!
546!-- Copy data from surface_mod
[3634]547!$ACC DATA &
548!$ACC COPYIN(bc_h(0:1)) &
549!$ACC COPYIN(bc_h(0)%i(1:bc_h(0)%ns)) &
550!$ACC COPYIN(bc_h(0)%j(1:bc_h(0)%ns)) &
551!$ACC COPYIN(bc_h(0)%k(1:bc_h(0)%ns)) &
552!$ACC COPYIN(bc_h(1)%i(1:bc_h(1)%ns)) &
553!$ACC COPYIN(bc_h(1)%j(1:bc_h(1)%ns)) &
554!$ACC COPYIN(bc_h(1)%k(1:bc_h(1)%ns))
555
[3761]556!
557!-- Copy data from statistics
[3634]558!$ACC DATA &
[3658]559!$ACC COPYIN(hom(0:nz+1,1:2,1:4,0)) &
[3634]560!$ACC COPYIN(rmask(nysg:nyng,nxlg:nxrg,0:statistic_regions)) &
561!$ACC COPYIN(weight_substep(1:intermediate_timestep_count_max)) &
[3658]562!$ACC COPY(sums_l(nzb:nzt+1,1:pr_palm,0)) &
[3634]563!$ACC COPY(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) &
564!$ACC COPY(sums_us2_ws_l(nzb:nzt+1,0)) &
565!$ACC COPY(sums_wsus_ws_l(nzb:nzt+1,0)) &
566!$ACC COPY(sums_vs2_ws_l(nzb:nzt+1,0)) &
567!$ACC COPY(sums_wsvs_ws_l(nzb:nzt+1,0)) &
568!$ACC COPY(sums_ws2_ws_l(nzb:nzt+1,0)) &
569!$ACC COPY(sums_wspts_ws_l(nzb:nzt+1,0)) &
570!$ACC COPY(sums_wssas_ws_l(nzb:nzt+1,0)) &
571!$ACC COPY(sums_wsqs_ws_l(nzb:nzt+1,0)) &
572!$ACC COPY(sums_wsqcs_ws_l(nzb:nzt+1,0)) &
573!$ACC COPY(sums_wsqrs_ws_l(nzb:nzt+1,0)) &
574!$ACC COPY(sums_wsncs_ws_l(nzb:nzt+1,0)) &
575!$ACC COPY(sums_wsnrs_ws_l(nzb:nzt+1,0)) &
576!$ACC COPY(sums_wsss_ws_l(nzb:nzt+1,0)) &
577!$ACC COPY(sums_salsa_ws_l(nzb:nzt+1,0))
578
[4472]579!
580!-- Next statement is to avoid compiler warnings about unused variables. Please
581!-- remove in case that you are using them. ddx and ddy need to be defined in
582!-- time_integration because of ACC COPYIN directive.
583    ddx = ddx
584    ddy = ddy
585
[3761]586#if defined( _OPENACC )
[3658]587    CALL enter_surface_arrays
588#endif
589
[1]590!
[1918]591!-- At beginning determine the first time step
592    CALL timestep
[4444]593
594#if defined( __parallel )
[1764]595!
596!-- Synchronize the timestep in case of nested run.
597    IF ( nested_run )  THEN
[1878]598!
599!--    Synchronization by unifying the time step.
600!--    Global minimum of all time-steps is used for all.
601       CALL pmci_synchronize
[1764]602    ENDIF
[4444]603#endif
[1764]604
[1918]605!
606!-- Determine and print out the run control quantities before the first time
607!-- step of this run. For the initial run, some statistics (e.g. divergence)
[3004]608!-- need to be determined first --> CALL flow_statistics at the beginning of
609!-- run_control
[1]610    CALL run_control
[108]611!
[4466]612!-- Data exchange between coupled models in case that a call has been omitted
[108]613!-- at the end of the previous run of a job chain.
[3761]614    IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled  .AND. .NOT. vnested )  THEN
[108]615!
[4466]616!--    In case of model termination initiated by the local model the coupler
617!--    must not be called because this would again cause an MPI hang.
[1918]618       DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
[108]619          CALL surface_coupler
620          time_coupling = time_coupling - dt_coupling
621       ENDDO
[3761]622       IF (time_coupling == 0.0_wp  .AND.  time_since_reference_point < dt_coupling )  THEN
[348]623          time_coupling = time_since_reference_point
624       ENDIF
[108]625    ENDIF
626
[3885]627    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'start' )
[3761]628
[1]629!
630!-- Start of the time loop
[3761]631    DO  WHILE ( simulated_time < end_time  .AND.  .NOT. stop_dt  .AND. .NOT. terminate_run )
[1]632
633       CALL cpu_log( log_point_s(10), 'timesteps', 'start' )
[4444]634
635#if defined( __parallel )
[1]636!
[2365]637!--    Vertical nesting: initialize fine grid
638       IF ( vnested ) THEN
639          IF ( .NOT. vnest_init  .AND.  simulated_time >= vnest_start_time )  THEN
[3719]640             CALL cpu_log( log_point_s(22), 'vnest_init', 'start' )
[2365]641             CALL vnest_init_fine
642             vnest_init = .TRUE.
[3719]643             CALL cpu_log( log_point_s(22), 'vnest_init', 'stop' )
[2365]644          ENDIF
645       ENDIF
[4444]646#endif
647
[2365]648!
[4466]649!--    Determine ug, vg and w_subs in dependence on data from external file
[1241]650!--    LSF_DATA
[1365]651       IF ( large_scale_forcing .AND. lsf_vert )  THEN
[1241]652           CALL ls_forcing_vert ( simulated_time )
[1365]653           sums_ls_l = 0.0_wp
[1241]654       ENDIF
655
656!
[4466]657!--    Set pt_init and q_init to the current profiles taken from
658!--    NUDGING_DATA
[1380]659       IF ( nudging )  THEN
660           CALL nudge_ref ( simulated_time )
661!
662!--        Store temperature gradient at the top boundary for possible Neumann
663!--        boundary condition
664           bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1)
665           bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
[3298]666           IF ( air_chemistry )  THEN
[3929]667              DO  lsp = 1, nvar
668                 bc_cs_t_val = (  chem_species(lsp)%conc_pr_init(nzt+1)                            &
669                                - chem_species(lsp)%conc_pr_init(nzt) )                            &
[3298]670                               / dzu(nzt+1)
671              ENDDO
672           ENDIF
[3864]673           IF ( salsa  .AND.  time_since_reference_point >= skip_time_do_salsa )  THEN
674              DO  ib = 1, nbins_aerosol
675                 bc_an_t_val = ( aerosol_number(ib)%init(nzt+1) - aerosol_number(ib)%init(nzt) ) / &
676                               dzu(nzt+1)
677                 DO  ic = 1, ncomponents_mass
678                    icc = ( ic - 1 ) * nbins_aerosol + ib
679                    bc_am_t_val = ( aerosol_mass(icc)%init(nzt+1) - aerosol_mass(icc)%init(nzt) ) /&
680                                  dzu(nzt+1)
681                 ENDDO
682              ENDDO
683              IF ( .NOT. salsa_gases_from_chem )  THEN
684                 DO  ig = 1, ngases_salsa
685                    bc_gt_t_val = ( salsa_gas(ig)%init(nzt+1) - salsa_gas(ig)%init(nzt) ) /        &
686                                  dzu(nzt+1)
687                 ENDDO
688              ENDIF
689           ENDIF
[1380]690       ENDIF
[2696]691!
[4466]692!--    Input of boundary data.
[4226]693       IF ( nesting_offline )  CALL nesting_offl_input
[1380]694!
[4276]695!--    Execute all other module actions routines
[3684]696       CALL module_interface_actions( 'before_timestep' )
[4466]697
[1]698!--    Start of intermediate step loop
699       intermediate_timestep_count = 0
[3761]700       DO  WHILE ( intermediate_timestep_count < intermediate_timestep_count_max )
[1]701
702          intermediate_timestep_count = intermediate_timestep_count + 1
703
704!
705!--       Set the steering factors for the prognostic equations which depend
706!--       on the timestep scheme
707          CALL timestep_scheme_steering
708
709!
[1128]710!--       Calculate those variables needed in the tendency terms which need
711!--       global communication
[3761]712          IF ( .NOT. use_single_reference_value  .AND.  .NOT. use_initial_profile_as_reference )   &
713          THEN
[1179]714!
715!--          Horizontally averaged profiles to be used as reference state in
716!--          buoyancy terms (WARNING: only the respective last call of
717!--          calc_mean_profile defines the reference state!)
[1365]718             IF ( .NOT. neutral )  THEN
719                CALL calc_mean_profile( pt, 4 )
720                ref_state(:)  = hom(:,1,4,0) ! this is used in the buoyancy term
721             ENDIF
[3294]722             IF ( ocean_mode )  THEN
[2031]723                CALL calc_mean_profile( rho_ocean, 64 )
[1365]724                ref_state(:)  = hom(:,1,64,0)
725             ENDIF
726             IF ( humidity )  THEN
727                CALL calc_mean_profile( vpt, 44 )
728                ref_state(:)  = hom(:,1,44,0)
729             ENDIF
[2617]730!
731!--          Assure that ref_state does not become zero at any level
[4466]732!--          ( might be the case if a vertical level is completely occupied
[2617]733!--            with topography ).
[3761]734             ref_state = MERGE( MAXVAL(ref_state), ref_state, ref_state == 0.0_wp )
[1179]735          ENDIF
736
[3761]737          IF ( ( ws_scheme_mom .OR. ws_scheme_sca )  .AND.  intermediate_timestep_count == 1 )     &
738          THEN
739             CALL ws_statistics
740          ENDIF
[1365]741!
742!--       In case of nudging calculate current nudging time scale and horizontal
[1380]743!--       means of u, v, pt and q
[1365]744          IF ( nudging )  THEN
745             CALL calc_tnudge( simulated_time )
746             CALL calc_mean_profile( u, 1 )
747             CALL calc_mean_profile( v, 2 )
748             CALL calc_mean_profile( pt, 4 )
749             CALL calc_mean_profile( q, 41 )
750          ENDIF
[1128]751!
[3876]752!--       Execute all other module actions routunes
753          CALL module_interface_actions( 'before_prognostic_equations' )
754!
[1]755!--       Solve the prognostic equations. A fast cache optimized version with
756!--       only one single loop is used in case of Piascek-Williams advection
757!--       scheme. NEC vector machines use a different version, because
758!--       in the other versions a good vectorization is prohibited due to
759!--       inlining problems.
[1019]760          IF ( loop_optimization == 'cache' )  THEN
761             CALL prognostic_equations_cache
762          ELSEIF ( loop_optimization == 'vector' )  THEN
[63]763             CALL prognostic_equations_vector
[1]764          ENDIF
765!
[3159]766!--       Movement of agents in multi agent system
[3761]767          IF ( agents_active  .AND.  time_since_reference_point >= multi_agent_system_start  .AND. &
768               time_since_reference_point <= multi_agent_system_end  .AND.                         &
769               intermediate_timestep_count == 1 )                                                  &
770          THEN
[3159]771             CALL multi_agent_system
772             first_call_mas = .FALSE.
773          ENDIF
774
775!
[1]776!--       Exchange of ghost points (lateral boundary conditions)
[2118]777          CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
[1113]778
[2118]779          CALL exchange_horiz( u_p, nbgp )
780          CALL exchange_horiz( v_p, nbgp )
781          CALL exchange_horiz( w_p, nbgp )
782          CALL exchange_horiz( pt_p, nbgp )
783          IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e_p, nbgp )
[3761]784          IF ( rans_tke_e  .OR.  wang_kernel  .OR.  collision_turbulence                           &
[2696]785               .OR.  use_sgs_for_particles )  THEN
786             IF ( rans_tke_e )  THEN
787                CALL exchange_horiz( diss_p, nbgp )
788             ELSE
789                CALL exchange_horiz( diss, nbgp )
790             ENDIF
791          ENDIF
[3294]792          IF ( ocean_mode )  THEN
[2118]793             CALL exchange_horiz( sa_p, nbgp )
794             CALL exchange_horiz( rho_ocean, nbgp )
795             CALL exchange_horiz( prho, nbgp )
796          ENDIF
797          IF ( humidity )  THEN
798             CALL exchange_horiz( q_p, nbgp )
[3274]799             IF ( bulk_cloud_model .AND. microphysics_morrison )  THEN
[2292]800                CALL exchange_horiz( qc_p, nbgp )
801                CALL exchange_horiz( nc_p, nbgp )
802             ENDIF
[3274]803             IF ( bulk_cloud_model .AND. microphysics_seifert )  THEN
[2118]804                CALL exchange_horiz( qr_p, nbgp )
805                CALL exchange_horiz( nr_p, nbgp )
[1053]806             ENDIF
[2118]807          ENDIF
[2696]808          IF ( passive_scalar )  CALL exchange_horiz( s_p, nbgp )
[3929]809          IF ( air_chemistry )  THEN
810             DO  lsp = 1, nvar
811                CALL exchange_horiz( chem_species(lsp)%conc_p, nbgp )
[4029]812             ENDDO
813          ENDIF
814
815          IF ( salsa  .AND.  time_since_reference_point >= skip_time_do_salsa )  THEN
816             DO  ib = 1, nbins_aerosol
817                CALL exchange_horiz( aerosol_number(ib)%conc_p, nbgp )
818                DO  ic = 1, ncomponents_mass
819                   icc = ( ic - 1 ) * nbins_aerosol + ib
820                   CALL exchange_horiz( aerosol_mass(icc)%conc_p, nbgp )
821                ENDDO
822             ENDDO
823             IF ( .NOT. salsa_gases_from_chem )  THEN
824                DO  ig = 1, ngases_salsa
825                   CALL exchange_horiz( salsa_gas(ig)%conc_p, nbgp )
826                ENDDO
827             ENDIF
828          ENDIF
829          CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' )
830
[3929]831!
[4029]832!--       Boundary conditions for the prognostic quantities (except of the
[4281]833!--       velocities at the outflow in case of a non-cyclic lateral wall) and
834!--       boundary conditions for module-specific variables
[4268]835          CALL module_interface_boundary_conditions
[1]836!
[4047]837!--       Incrementing timestep counter
838          timestep_count = timestep_count + 1
[73]839
[4047]840          CALL cpu_log( log_point(28), 'swap_timelevel', 'start' )
[2365]841!
[4047]842!--       Set the swap level for all modules
843          CALL module_interface_swap_timelevel( MOD( timestep_count, 2) )
[4444]844
845#if defined( __parallel )
[4047]846!
847!--       Set the swap level for steering the pmc data transfer
848          IF ( nested_run )  CALL pmci_set_swaplevel( MOD( timestep_count, 2) + 1 )  !> @todo: why the +1 ?
[4444]849#endif
[4047]850
851          CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )
852
[4444]853#if defined( __parallel )
[4047]854!
[2365]855!--       Vertical nesting: Interpolate fine grid data to the coarse grid
856          IF ( vnest_init ) THEN
[3719]857             CALL cpu_log( log_point_s(37), 'vnest_anterpolate', 'start' )
[2365]858             CALL vnest_anterpolate
[3719]859             CALL cpu_log( log_point_s(37), 'vnest_anterpolate', 'stop' )
[2365]860          ENDIF
861
[1764]862          IF ( nested_run )  THEN
[1797]863
[1764]864             CALL cpu_log( log_point(60), 'nesting', 'start' )
[1762]865!
[1933]866!--          Domain nesting. The data transfer subroutines pmci_parent_datatrans
867!--          and pmci_child_datatrans are called inside the wrapper
[1797]868!--          subroutine pmci_datatrans according to the control parameters
869!--          nesting_mode and nesting_datatransfer_mode.
870!--          TO_DO: why is nesting_mode given as a parameter here?
871             CALL pmci_datatrans( nesting_mode )
[1762]872
[3761]873             IF ( TRIM( nesting_mode ) == 'two-way' .OR.  nesting_mode == 'vertical' )  THEN
[4029]874
875                CALL cpu_log( log_point_s(92), 'exchange-horiz-nest', 'start' )
[1762]876!
[1933]877!--             Exchange_horiz is needed for all parent-domains after the
[1764]878!--             anterpolation
879                CALL exchange_horiz( u, nbgp )
880                CALL exchange_horiz( v, nbgp )
881                CALL exchange_horiz( w, nbgp )
[2174]882                IF ( .NOT. neutral )  CALL exchange_horiz( pt, nbgp )
883
884                IF ( humidity )  THEN
885
886                   CALL exchange_horiz( q, nbgp )
887
[3274]888                   IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
[2292]889                       CALL exchange_horiz( qc, nbgp )
890                       CALL exchange_horiz( nc, nbgp )
891                   ENDIF
[3274]892                   IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
[2174]893                       CALL exchange_horiz( qr, nbgp )
894                       CALL exchange_horiz( nr, nbgp )
895                   ENDIF
896
897                ENDIF
898
[4466]899                IF ( passive_scalar )  CALL exchange_horiz( s, nbgp )
[3864]900
[2174]901                IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
[2773]902
[3761]903                IF ( .NOT. constant_diffusion  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
[2938]904                   CALL exchange_horiz( diss, nbgp )
[3761]905                ENDIF
[2938]906
[2773]907                IF ( air_chemistry )  THEN
[3929]908                   DO  n = 1, nvar
[4466]909                      CALL exchange_horiz( chem_species(n)%conc, nbgp )
[2773]910                   ENDDO
911                ENDIF
912
[3864]913                IF ( salsa  .AND. time_since_reference_point >= skip_time_do_salsa )  THEN
914                   DO  ib = 1, nbins_aerosol
915                      CALL exchange_horiz( aerosol_number(ib)%conc, nbgp )
916                      DO  ic = 1, ncomponents_mass
917                         icc = ( ic - 1 ) * nbins_aerosol + ib
918                         CALL exchange_horiz( aerosol_mass(icc)%conc, nbgp )
919                      ENDDO
920                   ENDDO
921                   IF ( .NOT. salsa_gases_from_chem )  THEN
922                      DO  ig = 1, ngases_salsa
923                         CALL exchange_horiz( salsa_gas(ig)%conc, nbgp )
924                      ENDDO
925                   ENDIF
926                ENDIF
[4029]927                CALL cpu_log( log_point_s(92), 'exchange-horiz-nest', 'stop' )
[3864]928
[1762]929             ENDIF
[4029]930
[1762]931!
[2311]932!--          Set boundary conditions again after interpolation and anterpolation.
933             CALL pmci_boundary_conds
[1764]934
[4029]935!
936!--          Set chemistry boundary conditions (decycling)
937             IF ( air_chemistry )  THEN
938                DO  lsp = 1, nvar
939                   lsp_usr = 1
940                   DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' )
941                      IF ( TRIM( chem_species(lsp)%name ) == TRIM( cs_name(lsp_usr) ) )  THEN
942                         CALL chem_boundary_conds( chem_species(lsp)%conc,                         &
943                                                   chem_species(lsp)%conc_pr_init )
944                      ENDIF
945                      lsp_usr = lsp_usr + 1
946                   ENDDO
947                ENDDO
948             ENDIF
949
950!
951!--          Set SALSA boundary conditions (decycling)
952             IF ( salsa  .AND. time_since_reference_point >= skip_time_do_salsa )  THEN
953                DO  ib = 1, nbins_aerosol
954                   CALL salsa_boundary_conds( aerosol_number(ib)%conc, aerosol_number(ib)%init )
955                   DO  ic = 1, ncomponents_mass
956                      icc = ( ic - 1 ) * nbins_aerosol + ib
957                      CALL salsa_boundary_conds( aerosol_mass(icc)%conc, aerosol_mass(icc)%init )
958                   ENDDO
959                ENDDO
960                IF ( .NOT. salsa_gases_from_chem )  THEN
961                   DO  ig = 1, ngases_salsa
962                      CALL salsa_boundary_conds( salsa_gas(ig)%conc, salsa_gas(ig)%init )
963                   ENDDO
964                ENDIF
965             ENDIF
966
[1764]967             CALL cpu_log( log_point(60), 'nesting', 'stop' )
968
[1762]969          ENDIF
[4444]970#endif
[1762]971
972!
[1]973!--       Temperature offset must be imposed at cyclic boundaries in x-direction
974!--       when a sloping surface is used
975          IF ( sloping_surface )  THEN
[3761]976             IF ( nxl ==  0 )  pt(:,:,nxlg:nxl-1) = pt(:,:,nxlg:nxl-1) - pt_slope_offset
977             IF ( nxr == nx )  pt(:,:,nxr+1:nxrg) = pt(:,:,nxr+1:nxrg) + pt_slope_offset
[1]978          ENDIF
979
980!
[151]981!--       Impose a turbulent inflow using the recycling method
[3719]982          IF ( turbulent_inflow )  CALL inflow_turbulence
[151]983
984!
[2050]985!--       Set values at outflow boundary using the special outflow condition
[3719]986          IF ( turbulent_outflow )  CALL outflow_turbulence
[2050]987
988!
[1]989!--       Impose a random perturbation on the horizontal velocity field
[3761]990          IF ( create_disturbances  .AND.  ( call_psolver_at_all_substeps  .AND.                   &
991               intermediate_timestep_count == intermediate_timestep_count_max )                    &
992               .OR. ( .NOT. call_psolver_at_all_substeps  .AND.  intermediate_timestep_count == 1 ) ) &
[1]993          THEN
994             time_disturb = time_disturb + dt_3d
995             IF ( time_disturb >= dt_disturb )  THEN
[3761]996                IF ( disturbance_energy_limit /= 0.0_wp  .AND.                                     &
[1736]997                     hom(nzb+5,1,pr_palm,0) < disturbance_energy_limit )  THEN
[2232]998                   CALL disturb_field( 'u', tend, u )
999                   CALL disturb_field( 'v', tend, v )
[3761]1000                ELSEIF ( ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )                                &
1001                         .AND. .NOT. child_domain  .AND.  .NOT.  nesting_offline )                 &
[3182]1002                THEN
[1]1003!
1004!--                Runs with a non-cyclic lateral wall need perturbations
1005!--                near the inflow throughout the whole simulation
1006                   dist_range = 1
[2232]1007                   CALL disturb_field( 'u', tend, u )
1008                   CALL disturb_field( 'v', tend, v )
[1]1009                   dist_range = 0
1010                ENDIF
1011                time_disturb = time_disturb - dt_disturb
1012             ENDIF
1013          ENDIF
1014
1015!
[4466]1016!--       Map forcing data derived from larger scale model onto domain
[4226]1017!--       boundaries. Further, update geostrophic wind components.
[3761]1018          IF ( nesting_offline  .AND.  intermediate_timestep_count ==                              &
[4226]1019                                       intermediate_timestep_count_max  )  THEN
[4466]1020!--          Determine interpolation factor before boundary conditions and geostrophic wind
[4226]1021!--          is updated.
1022             CALL nesting_offl_interpolation_factor
[3347]1023             CALL nesting_offl_bc
[4226]1024             CALL nesting_offl_geostrophic_wind
1025          ENDIF
[2938]1026!
[4022]1027!--       Impose a turbulent inflow using synthetic generated turbulence.
1028          IF ( use_syn_turb_gen  .AND.                                                             &
1029               intermediate_timestep_count == intermediate_timestep_count_max )  THEN
[3719]1030             CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'start' )
[3347]1031             CALL stg_main
[3719]1032             CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'stop' )
[2696]1033          ENDIF
1034!
[3347]1035!--       Ensure mass conservation. This need to be done after imposing
1036!--       synthetic turbulence and top boundary condition for pressure is set to
[4466]1037!--       Neumann conditions.
[3347]1038!--       Is this also required in case of Dirichlet?
1039          IF ( nesting_offline )  CALL nesting_offl_mass_conservation
1040!
[1]1041!--       Reduce the velocity divergence via the equation for perturbation
1042!--       pressure.
[106]1043          IF ( intermediate_timestep_count == 1  .OR. &
1044                call_psolver_at_all_substeps )  THEN
[2365]1045
1046             IF (  vnest_init ) THEN
[4444]1047#if defined( __parallel )
[2365]1048!
1049!--             Compute pressure in the CG, interpolate top boundary conditions
1050!--             to the FG and then compute pressure in the FG
1051                IF ( coupling_mode == 'vnested_crse' )  CALL pres
1052
[3719]1053                CALL cpu_log( log_point_s(30), 'vnest_bc', 'start' )
[2365]1054                CALL vnest_boundary_conds
[3719]1055                CALL cpu_log( log_point_s(30), 'vnest_bc', 'stop' )
[4466]1056
[2365]1057                IF ( coupling_mode == 'vnested_fine' )  CALL pres
1058
1059!--             Anterpolate TKE, satisfy Germano Identity
[3719]1060                CALL cpu_log( log_point_s(28), 'vnest_anter_e', 'start' )
[2365]1061                CALL vnest_anterpolate_e
[3719]1062                CALL cpu_log( log_point_s(28), 'vnest_anter_e', 'stop' )
[4444]1063#else
1064                CONTINUE
1065#endif
[2365]1066
1067             ELSE
[4444]1068#if defined( __parallel )
[4268]1069!
[4010]1070!--             Mass (volume) flux correction to ensure global mass conservation for child domains.
1071                IF ( child_domain )  THEN
1072                   IF ( nesting_mode == 'vertical' )  THEN
1073                      CALL pmci_ensure_nest_mass_conservation_vertical
1074                   ELSE
1075                      CALL pmci_ensure_nest_mass_conservation
1076                   ENDIF
1077                ENDIF
[4444]1078#endif
[2365]1079                CALL pres
1080
1081             ENDIF
1082
[1]1083          ENDIF
[4275]1084!
1085!--       Particle transport/physics with the Lagrangian particle model
1086!--       (only once during intermediate steps, because it uses an Euler-step)
1087!--       ### particle model should be moved before prognostic_equations, in order
1088!--       to regard droplet interactions directly
[1]1089
[4276]1090          CALL module_interface_actions( 'after_pressure_solver' )
[1]1091!
[4275]1092!--       Interaction of droplets with temperature and mixing ratio.
1093!--       Droplet condensation and evaporation is calculated within
1094!--       advec_particles.
1095!
[1]1096!--       If required, compute liquid water content
[3274]1097          IF ( bulk_cloud_model )  THEN
[1015]1098             CALL calc_liquid_water_content
1099          ENDIF
[2174]1100!
[4466]1101!--       If required, compute virtual potential temperature
1102          IF ( humidity )  THEN
1103             CALL compute_vpt
1104          ENDIF
[1585]1105
[1]1106!
1107!--       Compute the diffusion quantities
1108          IF ( .NOT. constant_diffusion )  THEN
1109
1110!
[4466]1111!--          Determine surface fluxes shf and qsws and surface values
1112!--          pt_surface and q_surface in dependence on data from external
[1276]1113!--          file LSF_DATA respectively
[3761]1114             IF ( ( large_scale_forcing .AND. lsf_surf ) .AND.                                     &
1115                 intermediate_timestep_count == intermediate_timestep_count_max )                  &
[1276]1116             THEN
[2320]1117                CALL ls_forcing_surf( simulated_time )
[1276]1118             ENDIF
1119
1120!
[4466]1121!--          First the vertical (and horizontal) fluxes in the surface
[2232]1122!--          (constant flux) layer are computed
[1691]1123             IF ( constant_flux_layer )  THEN
1124                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'start' )
1125                CALL surface_layer_fluxes
1126                CALL cpu_log( log_point(19), 'surface_layer_fluxes', 'stop' )
[1]1127             ENDIF
1128!
[4466]1129!--          If required, solve the energy balance for the surface and run soil
[2232]1130!--          model. Call for horizontal as well as vertical surfaces
[2696]1131             IF ( land_surface .AND. time_since_reference_point >= skip_time_do_lsm)  THEN
[1691]1132
1133                CALL cpu_log( log_point(54), 'land_surface', 'start' )
[2232]1134!
1135!--             Call for horizontal upward-facing surfaces
1136                CALL lsm_energy_balance( .TRUE., -1 )
[2299]1137                CALL lsm_soil_model( .TRUE., -1, .TRUE. )
[2232]1138!
1139!--             Call for northward-facing surfaces
1140                CALL lsm_energy_balance( .FALSE., 0 )
[2299]1141                CALL lsm_soil_model( .FALSE., 0, .TRUE. )
[2232]1142!
1143!--             Call for southward-facing surfaces
1144                CALL lsm_energy_balance( .FALSE., 1 )
[2299]1145                CALL lsm_soil_model( .FALSE., 1, .TRUE. )
[2232]1146!
1147!--             Call for eastward-facing surfaces
1148                CALL lsm_energy_balance( .FALSE., 2 )
[2299]1149                CALL lsm_soil_model( .FALSE., 2, .TRUE. )
[2232]1150!
1151!--             Call for westward-facing surfaces
1152                CALL lsm_energy_balance( .FALSE., 3 )
[2299]1153                CALL lsm_soil_model( .FALSE., 3, .TRUE. )
[4268]1154
[2696]1155!
1156!--             At the end, set boundary conditons for potential temperature
[4466]1157!--             and humidity after running the land-surface model. This
[2696]1158!--             might be important for the nesting, where arrays are transfered.
1159                CALL lsm_boundary_condition
[2232]1160
[4268]1161
[1691]1162                CALL cpu_log( log_point(54), 'land_surface', 'stop' )
1163             ENDIF
1164!
[4466]1165!--          If required, solve the energy balance for urban surfaces and run
[2007]1166!--          the material heat model
1167             IF (urban_surface) THEN
1168                CALL cpu_log( log_point(74), 'urban_surface', 'start' )
[4268]1169
[3418]1170                CALL usm_surface_energy_balance( .FALSE. )
[2007]1171                IF ( usm_material_model )  THEN
[2696]1172                   CALL usm_green_heat_model
[3418]1173                   CALL usm_material_heat_model ( .FALSE. )
[2007]1174                ENDIF
[2696]1175
1176!
1177!--             At the end, set boundary conditons for potential temperature
[4466]1178!--             and humidity after running the urban-surface model. This
[2696]1179!--             might be important for the nesting, where arrays are transfered.
1180                CALL usm_boundary_condition
1181
[2007]1182                CALL cpu_log( log_point(74), 'urban_surface', 'stop' )
1183             ENDIF
1184!
[1]1185!--          Compute the diffusion coefficients
1186             CALL cpu_log( log_point(17), 'diffusivities', 'start' )
[75]1187             IF ( .NOT. humidity ) THEN
[3294]1188                IF ( ocean_mode )  THEN
[2696]1189                   CALL tcm_diffusivities( prho, prho_reference )
[97]1190                ELSE
[2696]1191                   CALL tcm_diffusivities( pt, pt_reference )
[97]1192                ENDIF
[1]1193             ELSE
[2696]1194                CALL tcm_diffusivities( vpt, pt_reference )
[1]1195             ENDIF
1196             CALL cpu_log( log_point(17), 'diffusivities', 'stop' )
[4444]1197
1198#if defined( __parallel )
[2696]1199!
1200!--          Vertical nesting: set fine grid eddy viscosity top boundary condition
1201             IF ( vnest_init )  CALL vnest_boundary_conds_khkm
[4444]1202#endif
[1]1203
1204          ENDIF
1205
1206       ENDDO   ! Intermediate step loop
[3634]1207
[1]1208!
[3634]1209!--    Will be used at some point by flow_statistics.
[3658]1210       !$ACC UPDATE &
[3634]1211       !$ACC HOST(sums_l_l(nzb:nzt+1,0:statistic_regions,0)) &
1212       !$ACC HOST(sums_us2_ws_l(nzb:nzt+1,0)) &
1213       !$ACC HOST(sums_wsus_ws_l(nzb:nzt+1,0)) &
1214       !$ACC HOST(sums_vs2_ws_l(nzb:nzt+1,0)) &
1215       !$ACC HOST(sums_wsvs_ws_l(nzb:nzt+1,0)) &
1216       !$ACC HOST(sums_ws2_ws_l(nzb:nzt+1,0)) &
1217       !$ACC HOST(sums_wspts_ws_l(nzb:nzt+1,0)) &
1218       !$ACC HOST(sums_wssas_ws_l(nzb:nzt+1,0)) &
1219       !$ACC HOST(sums_wsqs_ws_l(nzb:nzt+1,0)) &
1220       !$ACC HOST(sums_wsqcs_ws_l(nzb:nzt+1,0)) &
1221       !$ACC HOST(sums_wsqrs_ws_l(nzb:nzt+1,0)) &
1222       !$ACC HOST(sums_wsncs_ws_l(nzb:nzt+1,0)) &
1223       !$ACC HOST(sums_wsnrs_ws_l(nzb:nzt+1,0)) &
1224       !$ACC HOST(sums_wsss_ws_l(nzb:nzt+1,0)) &
1225       !$ACC HOST(sums_salsa_ws_l(nzb:nzt+1,0))
1226
1227!
[4064]1228!--    If required, calculate radiative fluxes and heating rates
1229       IF ( radiation  .AND.  time_since_reference_point > skip_time_do_radiation )  THEN
1230
1231          time_radiation = time_radiation + dt_3d
1232
1233          IF ( time_radiation >= dt_radiation  .OR.  force_radiation_call )  THEN
1234
1235             CALL cpu_log( log_point(50), 'radiation', 'start' )
1236
1237             IF ( .NOT. force_radiation_call )  THEN
1238                time_radiation = time_radiation - dt_radiation
1239             ENDIF
1240
1241!
1242!--          Adjust the current time to the time step of the radiation model.
[4466]1243!--          Needed since radiation is pre-calculated and stored only on apparent
[4064]1244!--          solar positions
1245             time_since_reference_point_save = time_since_reference_point
1246             time_since_reference_point = REAL( FLOOR( time_since_reference_point /             &
1247                                                       dt_radiation ), wp ) * dt_radiation
1248
1249             CALL radiation_control
1250
1251             IF ( ( urban_surface  .OR.  land_surface )  .AND.  radiation_interactions )  THEN
1252                CALL cpu_log( log_point_s(46), 'radiation_interaction', 'start' )
1253                CALL radiation_interaction
1254                CALL cpu_log( log_point_s(46), 'radiation_interaction', 'stop' )
1255             ENDIF
[4466]1256
[4064]1257!
1258!--          Return the current time to its original value
1259             time_since_reference_point = time_since_reference_point_save
1260
1261             CALL cpu_log( log_point(50), 'radiation', 'stop' )
1262
1263          ENDIF
1264       ENDIF
1265
[4466]1266
[4064]1267!
[4403]1268!-- 20200203 (ECC)
1269!-- allows for emission update mode in legacy mode as well as on-demand mode
1270!-- note that under on-demand mode emission update is no longer restricted to
1271!-- an hourly frequency, but whenever the simulation time corresponds to an
1272!-- inrement in emission timestamp value
1273
[3298]1274!
[4403]1275!-- If required, consider chemical emissions
1276
1277       IF  ( air_chemistry .AND. emissions_anthropogenic )  THEN
1278
1279          IF  ( emiss_read_legacy_mode )  THEN
1280!
1281!-- get hourly index and updates emission data when the hour is passed
1282
1283             CALL get_date_time( time_since_reference_point, hour=hour )
1284
1285             IF  ( hour_call_emis /= hour )   THEN
1286
1287                CALL chem_emissions_setup( chem_emis_att, chem_emis, n_matched_vars )
1288                hour_call_emis = hour
1289
1290             ENDIF
1291
1292          ELSE
1293
1294             CALL chem_emissions_update_on_demand
1295
[3298]1296          ENDIF
[4403]1297
[2766]1298       ENDIF
[4403]1299
1300
[3864]1301!
1302!--    If required, consider aerosol emissions for the salsa model
1303       IF ( salsa )  THEN
1304!
1305!--       Call emission routine to update emissions if needed
1306          CALL salsa_emission_update
[3569]1307
[3864]1308       ENDIF
[2696]1309!
[3469]1310!--    If required, calculate indoor temperature, waste heat, heat flux
1311!--    through wall, etc.
[3744]1312!--    dt_indoor steers the frequency of the indoor model calculations.
1313!--    Note, at first timestep indoor model is called, in order to provide
[4466]1314!--    a waste heat flux.
[3647]1315       IF ( indoor_model )  THEN
[3469]1316
1317          time_indoor = time_indoor + dt_3d
1318
[3761]1319          IF ( time_indoor >= dt_indoor  .OR.  current_timestep_number == 0 )  THEN
[3469]1320
1321             time_indoor = time_indoor - dt_indoor
1322
1323             CALL cpu_log( log_point(76), 'indoor_model', 'start' )
1324             CALL im_main_heatcool
1325             CALL cpu_log( log_point(76), 'indoor_model', 'stop' )
1326
1327          ENDIF
1328       ENDIF
1329!
[1]1330!--    Increase simulation time and output times
[1111]1331       nr_timesteps_this_run      = nr_timesteps_this_run + 1
[291]1332       current_timestep_number    = current_timestep_number + 1
1333       simulated_time             = simulated_time   + dt_3d
1334       time_since_reference_point = simulated_time - coupling_start_time
[2941]1335       simulated_time_chr         = time_to_string( time_since_reference_point )
[291]1336
[1957]1337
[3646]1338       IF ( time_since_reference_point >= skip_time_data_output_av )  THEN
[1]1339          time_do_av         = time_do_av       + dt_3d
1340       ENDIF
[3646]1341       IF ( time_since_reference_point >= skip_time_do2d_xy )  THEN
[1]1342          time_do2d_xy       = time_do2d_xy     + dt_3d
1343       ENDIF
[3646]1344       IF ( time_since_reference_point >= skip_time_do2d_xz )  THEN
[1]1345          time_do2d_xz       = time_do2d_xz     + dt_3d
1346       ENDIF
[3646]1347       IF ( time_since_reference_point >= skip_time_do2d_yz )  THEN
[1]1348          time_do2d_yz       = time_do2d_yz     + dt_3d
1349       ENDIF
[3646]1350       IF ( time_since_reference_point >= skip_time_do3d    )  THEN
[1]1351          time_do3d          = time_do3d        + dt_3d
1352       ENDIF
[410]1353       DO  mid = 1, masks
[3646]1354          IF ( time_since_reference_point >= skip_time_domask(mid) )  THEN
[410]1355             time_domask(mid)= time_domask(mid) + dt_3d
1356          ENDIF
1357       ENDDO
[3646]1358       IF ( time_since_reference_point >= skip_time_dosp )  THEN
[1]1359          time_dosp       = time_dosp        + dt_3d
1360       ENDIF
1361       time_dots          = time_dots        + dt_3d
[849]1362       IF ( .NOT. first_call_lpm )  THEN
[1]1363          time_dopts      = time_dopts       + dt_3d
1364       ENDIF
[3646]1365       IF ( time_since_reference_point >= skip_time_dopr )  THEN
[1]1366          time_dopr       = time_dopr        + dt_3d
1367       ENDIF
[3467]1368       time_dopr_listing  = time_dopr_listing + dt_3d
[1]1369       time_run_control   = time_run_control + dt_3d
[3347]1370!
[3421]1371!--    Increment time-counter for surface output
[3648]1372       IF ( surface_output )  THEN
[3646]1373          IF ( time_since_reference_point >= skip_time_dosurf )  THEN
[3421]1374             time_dosurf    = time_dosurf + dt_3d
1375          ENDIF
[3646]1376          IF ( time_since_reference_point >= skip_time_dosurf_av )  THEN
[3421]1377             time_dosurf_av = time_dosurf_av + dt_3d
1378          ENDIF
1379       ENDIF
1380!
[3988]1381!--    Increment time-counter for virtual measurements
1382       IF ( virtual_measurement  .AND.  vm_time_start <= time_since_reference_point )  THEN
1383          time_virtual_measurement = time_virtual_measurement + dt_3d
1384       ENDIF
[4466]1385
[3988]1386!
[4420]1387!--    Increment time-counter for wind turbine data output
1388       IF ( wind_turbine )  THEN
1389          time_wtm = time_wtm + dt_3d
1390       ENDIF
[4466]1391
[4420]1392!
[3347]1393!--    In case of synthetic turbulence generation and parametrized turbulence
[4466]1394!--    information, update the time counter and if required, adjust the
[3347]1395!--    STG to new atmospheric conditions.
1396       IF ( use_syn_turb_gen  )  THEN
1397          IF ( parametrize_inflow_turbulence )  THEN
1398             time_stg_adjust = time_stg_adjust + dt_3d
[3719]1399             IF ( time_stg_adjust >= dt_stg_adjust )  THEN
1400                CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'start' )
1401                CALL stg_adjust
1402                CALL cpu_log( log_point(57), 'synthetic_turbulence_gen', 'stop' )
1403             ENDIF
[3347]1404          ENDIF
1405          time_stg_call = time_stg_call + dt_3d
1406       ENDIF
[1]1407
1408!
[102]1409!--    Data exchange between coupled models
[3761]1410       IF ( coupling_mode /= 'uncoupled'  .AND.  run_coupled  .AND.  .NOT. vnested )  THEN
[102]1411          time_coupling = time_coupling + dt_3d
[343]1412
[108]1413!
[4466]1414!--       In case of model termination initiated by the local model
1415!--       (terminate_coupled > 0), the coupler must be skipped because it would
[108]1416!--       cause an MPI intercomminucation hang.
[4466]1417!--       If necessary, the coupler will be called at the beginning of the
[108]1418!--       next restart run.
[3761]1419          DO WHILE ( time_coupling >= dt_coupling  .AND.  terminate_coupled == 0 )
[102]1420             CALL surface_coupler
1421             time_coupling = time_coupling - dt_coupling
1422          ENDDO
1423       ENDIF
1424
1425!
[3448]1426!--    Biometeorology calculation of stationary thermal indices
[3647]1427!--    Todo (kanani): biometeorology needs own time_... treatment.
1428!--                   It might be that time_do2d_xy differs from time_do3d,
1429!--                   and then we might get trouble with the biomet output,
1430!--                   because we can have 2d and/or 3d biomet output!!
[3761]1431       IF ( biometeorology                                                                         &
1432            .AND. ( ( time_do3d >= dt_do3d  .AND.  time_since_reference_point >= skip_time_do3d )  &
1433                  .OR.                                                                             &
1434            ( time_do2d_xy >= dt_do2d_xy  .AND.  time_since_reference_point >= skip_time_do2d_xy ) &
[3647]1435                    ) )  THEN
[3569]1436!
1437!--       If required, do thermal comfort calculations
1438          IF ( thermal_comfort )  THEN
1439             CALL bio_calculate_thermal_index_maps ( .FALSE. )
1440          ENDIF
1441!
1442!--       If required, do UV exposure calculations
1443          IF ( uv_exposure )  THEN
[4126]1444             CALL bio_calculate_uv_exposure
[3569]1445          ENDIF
[3448]1446       ENDIF
1447
1448!
[3684]1449!--    Execute alle other module actions routunes
1450       CALL module_interface_actions( 'after_integration' )
[2817]1451
1452!
[1]1453!--    If Galilei transformation is used, determine the distance that the
1454!--    model has moved so far
1455       IF ( galilei_transformation )  THEN
1456          advected_distance_x = advected_distance_x + u_gtrans * dt_3d
1457          advected_distance_y = advected_distance_y + v_gtrans * dt_3d
1458       ENDIF
1459
1460!
1461!--    Check, if restart is necessary (because cpu-time is expiring or
1462!--    because it is forced by user) and set stop flag
[108]1463!--    This call is skipped if the remote model has already initiated a restart.
1464       IF ( .NOT. terminate_run )  CALL check_for_restart
[1]1465
1466!
1467!--    Carry out statistical analysis and output at the requested output times.
1468!--    The MOD function is used for calculating the output time counters (like
1469!--    time_dopr) in order to regard a possible decrease of the output time
1470!--    interval in case of restart runs
1471
1472!
1473!--    Set a flag indicating that so far no statistics have been created
1474!--    for this time step
1475       flow_statistics_called = .FALSE.
1476
1477!
1478!--    If required, call flow_statistics for averaging in time
[3761]1479       IF ( averaging_interval_pr /= 0.0_wp  .AND.                                                 &
1480            ( dt_dopr - time_dopr ) <= averaging_interval_pr  .AND.                                &
[3646]1481            time_since_reference_point >= skip_time_dopr )  THEN
[1]1482          time_dopr_av = time_dopr_av + dt_3d
1483          IF ( time_dopr_av >= dt_averaging_input_pr )  THEN
1484             do_sum = .TRUE.
[3761]1485             time_dopr_av = MOD( time_dopr_av, MAX( dt_averaging_input_pr, dt_3d ) )
[1]1486          ENDIF
1487       ENDIF
1488       IF ( do_sum )  CALL flow_statistics
1489
1490!
[410]1491!--    Sum-up 3d-arrays for later output of time-averaged 2d/3d/masked data
[3761]1492       IF ( averaging_interval /= 0.0_wp  .AND.                                                    &
1493            ( dt_data_output_av - time_do_av ) <= averaging_interval  .AND.                        &
1494            time_since_reference_point >= skip_time_data_output_av )                               &
[1]1495       THEN
1496          time_do_sla = time_do_sla + dt_3d
1497          IF ( time_do_sla >= dt_averaging_input )  THEN
[3994]1498             IF ( current_timestep_number > timestep_number_at_prev_calc )                         &
[4039]1499                CALL doq_calculate
[3994]1500
[1]1501             CALL sum_up_3d_data
1502             average_count_3d = average_count_3d + 1
1503             time_do_sla = MOD( time_do_sla, MAX( dt_averaging_input, dt_3d ) )
1504          ENDIF
1505       ENDIF
[3421]1506!
1507!--    Average surface data
[3648]1508       IF ( surface_output )  THEN
[3761]1509          IF ( averaging_interval_surf /= 0.0_wp                                                   &
1510                .AND.  ( dt_dosurf_av - time_dosurf_av ) <= averaging_interval_surf                &
[3647]1511                .AND.  time_since_reference_point >= skip_time_dosurf_av )  THEN
[4466]1512             IF ( time_dosurf_av >= dt_averaging_input )  THEN
[3648]1513                CALL surface_data_output_averaging
[3421]1514                average_count_surf = average_count_surf + 1
1515             ENDIF
1516          ENDIF
1517       ENDIF
[1]1518
1519!
1520!--    Calculate spectra for time averaging
[3761]1521       IF ( averaging_interval_sp /= 0.0_wp  .AND. ( dt_dosp - time_dosp ) <= averaging_interval_sp&
1522            .AND.  time_since_reference_point >= skip_time_dosp )  THEN
[1]1523          time_dosp_av = time_dosp_av + dt_3d
1524          IF ( time_dosp_av >= dt_averaging_input_pr )  THEN
1525             CALL calc_spectra
[3761]1526             time_dosp_av = MOD( time_dosp_av, MAX( dt_averaging_input_pr, dt_3d ) )
[1]1527          ENDIF
1528       ENDIF
1529
1530!
[1957]1531!--    Call flight module and output data
1532       IF ( virtual_flight )  THEN
1533          CALL flight_measurement
1534          CALL data_output_flight
1535       ENDIF
[3472]1536!
1537!--    Take virtual measurements
[3988]1538       IF ( virtual_measurement  .AND.  time_virtual_measurement >= dt_virtual_measurement         &
1539                                 .AND.  vm_time_start <= time_since_reference_point )  THEN
[3704]1540          CALL vm_sampling
1541          CALL vm_data_output
[3988]1542          time_virtual_measurement = MOD(      time_virtual_measurement,                           &
1543                                          MAX( dt_virtual_measurement, dt_3d ) )
[3704]1544       ENDIF
[4466]1545
[1957]1546!
[4420]1547!--    Output wind turbine data
1548       IF ( wind_turbine  .AND.  time_wtm >= dt_data_output_wtm )  THEN
1549          CALL wtm_data_output
1550          time_wtm = MOD( time_wtm, MAX( dt_data_output_wtm, dt_3d ) )
1551       ENDIF
[4466]1552
[4420]1553!
[1]1554!--    Profile output (ASCII) on file
1555       IF ( time_dopr_listing >= dt_dopr_listing )  THEN
1556          CALL print_1d
[3761]1557          time_dopr_listing = MOD( time_dopr_listing, MAX( dt_dopr_listing, dt_3d ) )
[1]1558       ENDIF
1559
1560!
1561!--    Graphic output for PROFIL
[3761]1562       IF ( time_dopr >= dt_dopr  .AND.  time_since_reference_point >= skip_time_dopr )  THEN
[1]1563          IF ( dopr_n /= 0 )  CALL data_output_profiles
1564          time_dopr = MOD( time_dopr, MAX( dt_dopr, dt_3d ) )
[1342]1565          time_dopr_av = 0.0_wp    ! due to averaging (see above)
[1]1566       ENDIF
1567
1568!
1569!--    Graphic output for time series
1570       IF ( time_dots >= dt_dots )  THEN
[48]1571          CALL data_output_tseries
[1]1572          time_dots = MOD( time_dots, MAX( dt_dots, dt_3d ) )
1573       ENDIF
1574
1575!
1576!--    Output of spectra (formatted for use with PROFIL), in case of no
1577!--    time averaging, spectra has to be calculated before
[3761]1578       IF ( time_dosp >= dt_dosp  .AND.  time_since_reference_point >= skip_time_dosp )  THEN
[1]1579          IF ( average_count_sp == 0 )  CALL calc_spectra
1580          CALL data_output_spectra
1581          time_dosp = MOD( time_dosp, MAX( dt_dosp, dt_3d ) )
1582       ENDIF
1583
1584!
1585!--    2d-data output (cross-sections)
[3761]1586       IF ( time_do2d_xy >= dt_do2d_xy  .AND.  time_since_reference_point >= skip_time_do2d_xy )  THEN
[3994]1587          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
[4039]1588             CALL doq_calculate
[3994]1589
[1]1590          CALL data_output_2d( 'xy', 0 )
1591          time_do2d_xy = MOD( time_do2d_xy, MAX( dt_do2d_xy, dt_3d ) )
1592       ENDIF
[3761]1593       IF ( time_do2d_xz >= dt_do2d_xz  .AND.  time_since_reference_point >= skip_time_do2d_xz )  THEN
[3994]1594          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
1595
[4039]1596             CALL doq_calculate
[1]1597          CALL data_output_2d( 'xz', 0 )
1598          time_do2d_xz = MOD( time_do2d_xz, MAX( dt_do2d_xz, dt_3d ) )
1599       ENDIF
[3761]1600       IF ( time_do2d_yz >= dt_do2d_yz  .AND.  time_since_reference_point >= skip_time_do2d_yz )  THEN
[3994]1601          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
[4039]1602             CALL doq_calculate
[3994]1603
[1]1604          CALL data_output_2d( 'yz', 0 )
1605          time_do2d_yz = MOD( time_do2d_yz, MAX( dt_do2d_yz, dt_3d ) )
1606       ENDIF
1607
1608!
1609!--    3d-data output (volume data)
[3761]1610       IF ( time_do3d >= dt_do3d  .AND.  time_since_reference_point >= skip_time_do3d )  THEN
[3994]1611          IF ( current_timestep_number > timestep_number_at_prev_calc )                            &
[4039]1612             CALL doq_calculate
[3994]1613
[1]1614          CALL data_output_3d( 0 )
1615          time_do3d = MOD( time_do3d, MAX( dt_do3d, dt_3d ) )
1616       ENDIF
1617
1618!
[1783]1619!--    Masked data output
[410]1620       DO  mid = 1, masks
[3761]1621          IF ( time_domask(mid) >= dt_domask(mid)                                                  &
1622               .AND.  time_since_reference_point >= skip_time_domask(mid) )  THEN
[3994]1623             IF ( current_timestep_number > timestep_number_at_prev_calc )                         &
[4039]1624                CALL doq_calculate
[3994]1625
[4069]1626             CALL data_output_mask( 0, mid )
[3761]1627             time_domask(mid) = MOD( time_domask(mid), MAX( dt_domask(mid), dt_3d ) )
[410]1628          ENDIF
1629       ENDDO
1630
1631!
1632!--    Output of time-averaged 2d/3d/masked data
[3761]1633       IF ( time_do_av >= dt_data_output_av                                                        &
1634            .AND.  time_since_reference_point >= skip_time_data_output_av )  THEN
[1]1635          CALL average_3d_data
[3742]1636!
1637!--       Udate thermal comfort indices based on updated averaged input
1638          IF ( biometeorology  .AND.  thermal_comfort )  THEN
1639             CALL bio_calculate_thermal_index_maps ( .TRUE. )
1640          ENDIF
[1]1641          CALL data_output_2d( 'xy', 1 )
1642          CALL data_output_2d( 'xz', 1 )
1643          CALL data_output_2d( 'yz', 1 )
1644          CALL data_output_3d( 1 )
[410]1645          DO  mid = 1, masks
[4069]1646             CALL data_output_mask( 1, mid )
[410]1647          ENDDO
[1]1648          time_do_av = MOD( time_do_av, MAX( dt_data_output_av, dt_3d ) )
1649       ENDIF
[3421]1650!
1651!--    Output of surface data, instantaneous and averaged data
[3648]1652       IF ( surface_output )  THEN
[3761]1653          IF ( time_dosurf >= dt_dosurf  .AND.  time_since_reference_point >= skip_time_dosurf )  THEN
[3648]1654             CALL surface_data_output( 0 )
[3421]1655             time_dosurf = MOD( time_dosurf, MAX( dt_dosurf, dt_3d ) )
1656          ENDIF
[3761]1657          IF ( time_dosurf_av >= dt_dosurf_av  .AND.  time_since_reference_point >= skip_time_dosurf_av )  THEN
[3648]1658             CALL surface_data_output( 1 )
[3421]1659             time_dosurf_av = MOD( time_dosurf_av, MAX( dt_dosurf_av, dt_3d ) )
1660          ENDIF
1661       ENDIF
[1]1662
1663!
1664!--    Output of particle time series
[253]1665       IF ( particle_advection )  THEN
[3761]1666          IF ( time_dopts >= dt_dopts  .OR.                                                        &
1667               ( time_since_reference_point >= particle_advection_start  .AND.                     &
[849]1668                 first_call_lpm ) )  THEN
[4017]1669             CALL lpm_data_output_ptseries
[253]1670             time_dopts = MOD( time_dopts, MAX( dt_dopts, dt_3d ) )
1671          ENDIF
[1]1672       ENDIF
1673
1674!
[3719]1675!--    If required, set the heat flux for the next time step to a random value
[2232]1676       IF ( constant_heatflux  .AND.  random_heatflux )  THEN
[3719]1677          IF ( surf_def_h(0)%ns >= 1 )  THEN
1678             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
1679             CALL disturb_heatflux( surf_def_h(0) )
1680             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
1681          ENDIF
1682          IF ( surf_lsm_h%ns    >= 1 )  THEN
1683             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
1684             CALL disturb_heatflux( surf_lsm_h    )
1685             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
1686          ENDIF
1687          IF ( surf_usm_h%ns    >= 1 )  THEN
1688             CALL cpu_log( log_point(23), 'disturb_heatflux', 'start' )
1689             CALL disturb_heatflux( surf_usm_h    )
1690             CALL cpu_log( log_point(23), 'disturb_heatflux', 'stop' )
1691          ENDIF
[2232]1692       ENDIF
[1]1693
1694!
[3684]1695!--    Execute alle other module actions routunes
1696       CALL module_interface_actions( 'after_timestep' )
[2817]1697
1698!
[1918]1699!--    Determine size of next time step. Save timestep dt_3d because it is
1700!--    newly calculated in routine timestep, but required further below for
1701!--    steering the run control output interval
1702       dt_3d_old = dt_3d
1703       CALL timestep
1704
[4444]1705#if defined( __parallel )
[1918]1706!
[1925]1707!--    Synchronize the timestep in case of nested run.
1708       IF ( nested_run )  THEN
1709!
1710!--       Synchronize by unifying the time step.
1711!--       Global minimum of all time-steps is used for all.
1712          CALL pmci_synchronize
1713       ENDIF
[4444]1714#endif
[1925]1715
1716!
[1918]1717!--    Computation and output of run control parameters.
1718!--    This is also done whenever perturbations have been imposed
[3761]1719       IF ( time_run_control >= dt_run_control  .OR.                                               &
1720            timestep_scheme(1:5) /= 'runge'  .OR.  disturbance_created )                           &
[1918]1721       THEN
1722          CALL run_control
1723          IF ( time_run_control >= dt_run_control )  THEN
[3761]1724             time_run_control = MOD( time_run_control, MAX( dt_run_control, dt_3d_old ) )
[1918]1725          ENDIF
1726       ENDIF
1727
1728!
[1402]1729!--    Output elapsed simulated time in form of a progress bar on stdout
1730       IF ( myid == 0 )  CALL output_progress_bar
1731
[1]1732       CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
1733
[667]1734
[1]1735    ENDDO   ! time loop
[3448]1736
[3761]1737#if defined( _OPENACC )
[3658]1738    CALL exit_surface_arrays
1739#endif
[3634]1740!$ACC END DATA
1741!$ACC END DATA
1742!$ACC END DATA
1743!$ACC END DATA
1744!$ACC END DATA
1745!$ACC END DATA
1746!$ACC END DATA
[4472]1747!$ACC END DATA
[3634]1748
[4444]1749#if defined( __parallel )
[3347]1750!
[4466]1751!-- Vertical nesting: Deallocate variables initialized for vertical nesting
[2365]1752    IF ( vnest_init )  CALL vnest_deallocate
[4444]1753#endif
[2365]1754
[1402]1755    IF ( myid == 0 )  CALL finish_progress_bar
1756
[3885]1757    CALL location_message( 'atmosphere (and/or ocean) time-stepping', 'finished' )
[1384]1758
[1]1759 END SUBROUTINE time_integration
Note: See TracBrowser for help on using the repository browser.