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

Last change on this file since 1918 was 1918, checked in by raasch, 8 years ago

bugfixes for calculating run control quantities, bugfix for calculating pressure with fft-method in case of Neumann conditions both at bottom and top, steering of pres modified, ocean mode now uses initial density profile as reference in the buoyancy term

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