source: palm/trunk/SOURCE/module_interface.f90 @ 4047

Last change on this file since 4047 was 4047, checked in by knoop, 5 years ago

Initial introduction of the dynamics module with only dynamics_swap_timelevel implemented

  • Property svn:keywords set to Id
File size: 80.1 KB
Line 
1!> @file module_interface.f90
2!------------------------------------------------------------------------------!
3! This file is part of PALM.
4!
5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2019 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: module_interface.f90 4047 2019-06-21 18:58:09Z knoop $
27! Introduction of the dynamics module
28!
29! 4039 2019-06-18 10:32:41Z suehring
30! Introduce diagnostic output
31!
32! 4028 2019-06-13 12:21:37Z schwenkel
33! Further modularization of particle code components
34!
35! 4017 2019-06-06 12:16:46Z schwenkel
36! local_pf need INTENT(INOUT) attribute rather than INTENT(OUT). This is
37! because INTENT(OUT) sets the array to not-defined. Especially for outputs that
38! are not defined everywhere, e.g. land-surface outputs, this will be
39! problematic as NaN will be output.
40!
41! 3987 2019-05-22 09:52:13Z kanani
42! Introduce switchable DEBUG file output via debug_message routine
43!
44! 3956 2019-05-07 12:32:52Z monakurppa
45! - Added calls for salsa_non_advective_processes and
46!   salsa_exchange_horiz_bounds
47! - Moved the call for salsa_data_output_2d/3d before that of
48!   radiation_data_output_2d/3d. radiation_data_output_2d/3d tries to read a
49!   salsa output variable and encounters a segmentation fault for "Ntot" due
50!   to the shortoutput name
51!
52! 3931 2019-04-24 16:34:28Z schwenkel
53! Changed non_transport_physics to non_advective_processes
54!
55! 3930 2019-04-24 14:57:18Z forkel
56! Correct/complete module_interface introduction for chemistry model
57!
58! 3887 2019 -04-12 08:47:41Z schwenkel
59! Changes related to global restructuring of location messages and introduction
60! of additional debug messages
61!
62! 3880 2019 -04-08 21:43:02Z knoop
63! Add a call for salsa_prognostic_equations
64!
65! 3840 2019-03-29 10:35:52Z knoop
66! bugfix: intent of dummy arguments changed to inout
67!
68! 3770 2019-02-28 11:22:32Z moh.hefny
69! removed unused variables in module_interface_check_data_output_ts
70!
71! 3767 08:18:02Z raasch
72! unused variable file_index removed from subroutine parameter list
73!
74! 3766 2019-02-26 16:23:41Z raasch
75! first argument removed from module_interface_rrd_*, statement added to avoid
76! compiler warning about unused variable, file reformatted with respect to coding
77! standards
78!
79! 3762 2019-02-25 16:54:16Z suehring
80! only pass required arguments to surface_data_output_rrd_local
81!
82! 3747 2019-02-16 15:15:23Z gronemeier
83! Call user_init_arrays
84!
85! 3745 2019-02-15 18:57:56Z suehring
86! Add indoor model
87!
88! 3744 2019-02-15 18:38:58Z suehring
89! Removed bio_check_parameters as the method is empty.
90!
91! 3735 2019-02-12 09:52:40Z dom_dwd_user
92! Accepting variable j from check_parameters and passing it to
93! bio_check_data_output
94! Add required restart data for surface output module
95!
96! 3731 2019-02-11 13:06:27Z suehring
97! Add check_parameters routine for virtual measurements
98!
99! 3711 2019-01-31 13:44:26Z knoop
100! Introduced module_interface_init_checks for post-init checks
101!
102! 3705 2019-01-29 19:56:39Z suehring
103! Add last_actions for virtual measurements
104!
105! 3704 2019-01-29 19:51:41Z suehring
106! Some interface calls moved to module_interface + cleanup
107!
108! 3684 2019-01-20 20:20:58Z knoop
109! Bugfix: made unit intend INOUT
110!
111! 3650 2019-01-04 13:01:33Z kanani
112! Add restart routines for biometeorology
113!
114! 3649 2019-01-02 16:52:21Z suehring
115! Initialize strings, in order to avoid compiler warnings for non-initialized
116! characters with intent(out) attribute
117!
118! 3648 2019-01-02 16:35:46Z suehring
119! Rename subroutines for surface-data output
120!
121! 3641 2018-12-23 22:10:01Z knoop
122! Initial implementation of the PALM module interface
123!
124!
125! Description:
126! ------------
127!> This is the interface between the PALM model core and all its modules.
128!>
129!> @todo Re-format module to be consistent with coding standard
130!------------------------------------------------------------------------------!
131 MODULE module_interface
132
133    USE indices,                                                               &
134        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
135
136    USE kinds
137
138!
139!-- load module-specific control parameters.
140!-- ToDo: move all of them to respective module or a dedicated central module
141
142    USE dynamics_mod, &
143        ONLY:  dynamics_parin, &
144               dynamics_check_parameters, &
145               dynamics_check_data_output_ts, &
146               dynamics_check_data_output_pr, &
147               dynamics_check_data_output, &
148               dynamics_init_masks, &
149               dynamics_define_netcdf_grid, &
150               dynamics_init_arrays, &
151               dynamics_init, &
152               dynamics_init_checks, &
153               dynamics_header, &
154               dynamics_actions, &
155               dynamics_non_advective_processes, &
156               dynamics_exchange_horiz, &
157               dynamics_prognostic_equations, &
158               dynamics_swap_timelevel, &
159               dynamics_3d_data_averaging, &
160               dynamics_data_output_2d, &
161               dynamics_data_output_3d, &
162               dynamics_statistics, &
163               dynamics_rrd_global, &
164               dynamics_rrd_local, &
165               dynamics_wrd_global, &
166               dynamics_wrd_local, &
167               dynamics_last_actions
168
169    USE turbulence_closure_mod, &
170        ONLY:  tcm_swap_timelevel
171
172    USE control_parameters,                                                    &
173        ONLY:  air_chemistry,                                                  &
174               biometeorology,                                                 &
175               debug_output,                                                   &
176               debug_output_timestep,                                          &
177               indoor_model,                                                   &
178               land_surface,                                                   &
179               large_scale_forcing,                                            &
180               nesting_offline,                                                &
181               nudging,                                                        &
182               ocean_mode,                                                     &
183               plant_canopy,                                                   &
184               salsa,                                                          &
185               surface_output,                                                 &
186               syn_turb_gen,                                                   &
187               urban_surface,                                                  &
188               virtual_flight,                                                 &
189               virtual_measurement,                                            &
190               wind_turbine
191
192!
193!-- load interface routines of all PALM modules
194    USE biometeorology_mod,                                                    &
195        ONLY:  bio_parin,                                                      &
196               bio_check_data_output,                                          &
197               bio_init,                                                       &
198               bio_init_checks,                                                &
199               bio_header,                                                     &
200               bio_3d_data_averaging,                                          &
201               bio_data_output_2d,                                             &
202               bio_data_output_3d,                                             &
203               bio_rrd_global,                                                 &
204               bio_rrd_local,                                                  &
205               bio_wrd_global,                                                 &
206               bio_wrd_local
207
208    USE bulk_cloud_model_mod,                                                  &
209        ONLY:  bulk_cloud_model,                                               &
210               bcm_parin,                                                      &
211               bcm_check_parameters,                                           &
212               bcm_check_data_output_pr,                                       &
213               bcm_check_data_output,                                          &
214               bcm_init_arrays,                                                &
215               bcm_init,                                                       &
216               bcm_header,                                                     &
217               bcm_actions,                                                    &
218               bcm_non_advective_processes,                                    &
219               bcm_exchange_horiz,                                             &
220               bcm_prognostic_equations,                                       &
221               bcm_swap_timelevel,                                             &
222               bcm_3d_data_averaging,                                          &
223               bcm_data_output_2d,                                             &
224               bcm_data_output_3d,                                             &
225               bcm_rrd_global,                                                 &
226               bcm_wrd_global,                                                 &
227               bcm_rrd_local,                                                  &
228               bcm_wrd_local
229
230   USE chemistry_model_mod,                                                    &
231       ONLY:  chem_parin,                                                      &
232              chem_check_parameters,                                           &
233              chem_check_data_output_pr,                                       &
234              chem_check_data_output,                                          &
235              chem_exchange_horiz_bounds,                                      &
236              chem_init_arrays,                                                &
237              chem_init,                                                       &
238              chem_header,                                                     &
239              chem_actions,                                                    &
240              chem_non_advective_processes,                                    &
241              chem_prognostic_equations,                                       &
242              chem_swap_timelevel,                                             &
243              chem_3d_data_averaging,                                          &
244              chem_data_output_2d,                                             &
245              chem_data_output_3d,                                             &
246              chem_statistics,                                                 &
247              chem_rrd_local,                                                  &
248              chem_wrd_local
249
250    USE diagnostic_output_quantities_mod,                                      &
251        ONLY:  doq_3d_data_averaging,                                          &
252               doq_check_data_output,                                          &
253               doq_define_netcdf_grid,                                         &
254               doq_output_2d,                                                  &
255               doq_output_3d,                                                  &
256               doq_wrd_local
257!                doq_rrd_local,                                                  &
258
259    USE flight_mod,                                                            &
260        ONLY:  flight_parin,                                                   &
261               flight_header,                                                  &
262               flight_init,                                                    &
263               flight_rrd_global,                                              &
264               flight_wrd_global
265
266    USE gust_mod,                                                              &
267        ONLY:  gust_module_enabled,                                            &
268               gust_parin,                                                     &
269               gust_check_parameters,                                          &
270               gust_check_data_output_pr,                                      &
271               gust_check_data_output,                                         &
272               gust_init_arrays,                                               &
273               gust_init,                                                      &
274               gust_header,                                                    &
275               gust_actions,                                                   &
276               gust_prognostic_equations,                                      &
277               gust_swap_timelevel,                                            &
278               gust_3d_data_averaging,                                         &
279               gust_data_output_2d,                                            &
280               gust_data_output_3d,                                            &
281               gust_statistics,                                                &
282               gust_rrd_global,                                                &
283               gust_wrd_global,                                                &
284               gust_rrd_local,                                                 &
285               gust_wrd_local
286
287    USE indoor_model_mod,                                                      &
288        ONLY:  im_parin,                                                       &
289               im_check_data_output,                                           &
290               im_check_parameters,                                            &
291               im_data_output_3d,                                              &
292               im_init
293
294    USE lagrangian_particle_model_mod,                                         &
295        ONLY:  lpm_parin,                                                      &
296               lpm_header,                                                     &
297               lpm_check_parameters,                                           &
298               lpm_init_arrays,                                                &
299               lpm_init,                                                       &
300               lpm_actions,                                                    &
301               lpm_rrd_global,                                                 &
302               lpm_rrd_local,                                                  &
303               lpm_wrd_local,                                                  &
304               lpm_wrd_global
305
306    USE land_surface_model_mod,                                                &
307        ONLY:  lsm_parin,                                                      &
308               lsm_check_parameters,                                           &
309               lsm_check_data_output_pr,                                       &
310               lsm_check_data_output,                                          &
311               lsm_init_arrays,                                                &
312               lsm_init,                                                       &
313               lsm_header,                                                     &
314               lsm_swap_timelevel,                                             &
315               lsm_3d_data_averaging,                                          &
316               lsm_data_output_2d,                                             &
317               lsm_rrd_local,                                                  &
318               lsm_wrd_local
319
320    USE lsf_nudging_mod,                                                       &
321        ONLY:  lsf_nudging_check_parameters,                                   &
322               lsf_nudging_check_data_output_pr,                               &
323               lsf_init,                                                       &
324               nudge_init,                                                     &
325               lsf_nudging_header
326
327    USE multi_agent_system_mod,                                                &
328        ONLY:  mas_parin
329
330    USE nesting_offl_mod,                                                      &
331        ONLY:  nesting_offl_parin,                                             &
332               nesting_offl_check_parameters,                                  &
333               nesting_offl_header
334
335    USE ocean_mod,                                                             &
336        ONLY:  ocean_parin,                                                    &
337               ocean_check_parameters,                                         &
338               ocean_check_data_output_pr,                                     &
339               ocean_check_data_output,                                        &
340               ocean_init_arrays,                                              &
341               ocean_init,                                                     &
342               ocean_header,                                                   &
343               ocean_actions,                                                  &
344               ocean_prognostic_equations,                                     &
345               ocean_swap_timelevel,                                           &
346               ocean_3d_data_averaging,                                        &
347               ocean_data_output_2d,                                           &
348               ocean_data_output_3d,                                           &
349               ocean_rrd_global,                                               &
350               ocean_wrd_global,                                               &
351               ocean_rrd_local,                                                &
352               ocean_wrd_local
353
354    USE particle_attributes,                                                   &
355        ONLY:  particle_advection
356
357    USE plant_canopy_model_mod,                                                &
358         ONLY: pcm_parin,                                                      &
359               pcm_check_parameters,                                           &
360               pcm_check_data_output,                                          &
361               pcm_init,                                                       &
362               pcm_header,                                                     &
363               pcm_data_output_3d
364
365    USE radiation_model_mod,                                                   &
366        ONLY:  radiation,                                                      &
367               radiation_parin,                                                &
368               radiation_check_parameters,                                     &
369               radiation_check_data_output_ts,                                 &
370               radiation_check_data_output_pr,                                 &
371               radiation_check_data_output,                                    &
372               radiation_init,                                                 &
373               radiation_header,                                               &
374               radiation_3d_data_averaging,                                    &
375               radiation_data_output_2d,                                       &
376               radiation_data_output_3d,                                       &
377               radiation_rrd_local,                                            &
378               radiation_wrd_local
379
380    USE salsa_mod,                                                             &
381        ONLY:  salsa_parin,                                                    &
382               salsa_check_parameters,                                         &
383               salsa_check_data_output,                                        &
384               salsa_init_arrays,                                              &
385               salsa_init,                                                     &
386               salsa_header,                                                   &
387               salsa_actions,                                                  &
388               salsa_non_advective_processes,                                  &
389               salsa_exchange_horiz_bounds,                                    &
390               salsa_prognostic_equations,                                     &
391               salsa_swap_timelevel,                                           &
392               salsa_3d_data_averaging,                                        &
393               salsa_data_output_2d,                                           &
394               salsa_data_output_3d,                                           &
395               salsa_rrd_local,                                                &
396               salsa_wrd_local
397
398    USE spectra_mod,                                                           &
399        ONLY:  calculate_spectra,                                              &
400               spectra_parin,                                                  &
401               spectra_check_parameters,                                       &
402               spectra_header
403
404    USE surface_data_output_mod,                                               &
405        ONLY:  surface_data_output_parin,                                      &
406               surface_data_output_check_parameters,                           &
407               surface_data_output_init_arrays,                                &
408               surface_data_output_rrd_local,                                  &
409               surface_data_output_rrd_global,                                 &
410               surface_data_output_wrd_local,                                  &
411               surface_data_output_wrd_global
412
413    USE synthetic_turbulence_generator_mod,                                    &
414        ONLY:  stg_parin,                                                      &
415               stg_check_parameters,                                           &
416               stg_header,                                                     &
417               stg_rrd_global,                                                 &
418               stg_wrd_global
419
420    USE urban_surface_mod,                                                     &
421        ONLY:  usm_parin,                                                      &
422               usm_check_parameters,                                           &
423               usm_check_data_output,                                          &
424               usm_init_arrays,                                                &
425               usm_init,                                                       &
426               usm_swap_timelevel,                                             &
427               usm_3d_data_averaging,                                          &
428               usm_rrd_local,                                                  &
429               usm_wrd_local
430
431    USE virtual_measurement_mod,                                               &
432        ONLY:  vm_check_parameters,                                            &
433               vm_init,                                                        &
434               vm_last_actions,                                                &
435               vm_parin
436
437    USE wind_turbine_model_mod,                                                &
438        ONLY:  wtm_parin,                                                      &
439               wtm_check_parameters,                                           &
440               wtm_init_arrays,                                                &
441               wtm_init,                                                       &
442               wtm_actions,                                                    &
443               wtm_rrd_global,                                                 &
444               wtm_wrd_global
445
446    USE user,                                                                  &
447        ONLY:  user_module_enabled,                                            &
448               user_parin,                                                     &
449               user_check_parameters,                                          &
450               user_check_data_output_ts,                                      &
451               user_check_data_output_pr,                                      &
452               user_check_data_output,                                         &
453               user_init,                                                      &
454               user_init_arrays,                                               &
455               user_header,                                                    &
456               user_actions,                                                   &
457               user_3d_data_averaging,                                         &
458               user_data_output_2d,                                            &
459               user_data_output_3d,                                            &
460               user_statistics,                                                &
461               user_rrd_global,                                                &
462               user_rrd_local,                                                 &
463               user_wrd_global,                                                &
464               user_wrd_local,                                                 &
465               user_last_actions
466
467    IMPLICIT NONE
468
469    PRIVATE
470
471!
472!-- Public functions
473    PUBLIC                                                                     &
474       module_interface_parin,                                                 &
475       module_interface_check_parameters,                                      &
476       module_interface_check_data_output_ts,                                  &
477       module_interface_check_data_output_pr,                                  &
478       module_interface_check_data_output,                                     &
479       module_interface_init_masks,                                            &
480       module_interface_define_netcdf_grid,                                    &
481       module_interface_init_arrays,                                           &
482       module_interface_init,                                                  &
483       module_interface_init_checks,                                           &
484       module_interface_header,                                                &
485       module_interface_actions,                                               &
486       module_interface_non_advective_processes,                               &
487       module_interface_exchange_horiz,                                        &
488       module_interface_prognostic_equations,                                  &
489       module_interface_swap_timelevel,                                        &
490       module_interface_3d_data_averaging,                                     &
491       module_interface_data_output_2d,                                        &
492       module_interface_data_output_3d,                                        &
493       module_interface_statistics,                                            &
494       module_interface_rrd_global,                                            &
495       module_interface_wrd_global,                                            &
496       module_interface_rrd_local,                                             &
497       module_interface_wrd_local,                                             &
498       module_interface_last_actions
499
500
501    INTERFACE module_interface_parin
502       MODULE PROCEDURE module_interface_parin
503    END INTERFACE module_interface_parin
504
505    INTERFACE module_interface_check_parameters
506       MODULE PROCEDURE module_interface_check_parameters
507    END INTERFACE module_interface_check_parameters
508
509    INTERFACE module_interface_check_data_output_ts
510       MODULE PROCEDURE module_interface_check_data_output_ts
511    END INTERFACE module_interface_check_data_output_ts
512
513    INTERFACE module_interface_check_data_output_pr
514       MODULE PROCEDURE module_interface_check_data_output_pr
515    END INTERFACE module_interface_check_data_output_pr
516
517    INTERFACE module_interface_check_data_output
518       MODULE PROCEDURE module_interface_check_data_output
519    END INTERFACE module_interface_check_data_output
520
521    INTERFACE module_interface_init_masks
522       MODULE PROCEDURE module_interface_init_masks
523    END INTERFACE module_interface_init_masks
524
525    INTERFACE module_interface_define_netcdf_grid
526       MODULE PROCEDURE module_interface_define_netcdf_grid
527    END INTERFACE module_interface_define_netcdf_grid
528
529    INTERFACE module_interface_init_arrays
530       MODULE PROCEDURE module_interface_init_arrays
531    END INTERFACE module_interface_init_arrays
532
533    INTERFACE module_interface_init
534       MODULE PROCEDURE module_interface_init
535    END INTERFACE module_interface_init
536
537    INTERFACE module_interface_init_checks
538       MODULE PROCEDURE module_interface_init_checks
539    END INTERFACE module_interface_init_checks
540
541    INTERFACE module_interface_header
542       MODULE PROCEDURE module_interface_header
543    END INTERFACE module_interface_header
544
545    INTERFACE module_interface_actions
546       MODULE PROCEDURE module_interface_actions
547       MODULE PROCEDURE module_interface_actions_ij
548    END INTERFACE module_interface_actions
549
550    INTERFACE module_interface_non_advective_processes
551       MODULE PROCEDURE module_interface_non_advective_processes
552       MODULE PROCEDURE module_interface_non_advective_processes_ij
553    END INTERFACE module_interface_non_advective_processes
554
555    INTERFACE module_interface_exchange_horiz
556       MODULE PROCEDURE module_interface_exchange_horiz
557    END INTERFACE module_interface_exchange_horiz
558
559    INTERFACE module_interface_prognostic_equations
560       MODULE PROCEDURE module_interface_prognostic_equations
561       MODULE PROCEDURE module_interface_prognostic_equations_ij
562    END INTERFACE module_interface_prognostic_equations
563
564    INTERFACE module_interface_swap_timelevel
565       MODULE PROCEDURE module_interface_swap_timelevel
566    END INTERFACE module_interface_swap_timelevel
567
568    INTERFACE module_interface_3d_data_averaging
569       MODULE PROCEDURE module_interface_3d_data_averaging
570    END INTERFACE module_interface_3d_data_averaging
571
572    INTERFACE module_interface_data_output_2d
573       MODULE PROCEDURE module_interface_data_output_2d
574    END INTERFACE module_interface_data_output_2d
575
576    INTERFACE module_interface_data_output_3d
577       MODULE PROCEDURE module_interface_data_output_3d
578    END INTERFACE module_interface_data_output_3d
579
580    INTERFACE module_interface_statistics
581       MODULE PROCEDURE module_interface_statistics
582    END INTERFACE module_interface_statistics
583
584    INTERFACE module_interface_rrd_global
585       MODULE PROCEDURE module_interface_rrd_global
586    END INTERFACE module_interface_rrd_global
587
588    INTERFACE module_interface_wrd_global
589       MODULE PROCEDURE module_interface_wrd_global
590    END INTERFACE module_interface_wrd_global
591
592    INTERFACE module_interface_rrd_local
593       MODULE PROCEDURE module_interface_rrd_local
594    END INTERFACE module_interface_rrd_local
595
596    INTERFACE module_interface_wrd_local
597       MODULE PROCEDURE module_interface_wrd_local
598    END INTERFACE module_interface_wrd_local
599
600    INTERFACE module_interface_last_actions
601       MODULE PROCEDURE module_interface_last_actions
602    END INTERFACE module_interface_last_actions
603
604
605 CONTAINS
606
607
608!------------------------------------------------------------------------------!
609! Description:
610! ------------
611!> Read module-specific parameter namelists
612!------------------------------------------------------------------------------!
613 SUBROUTINE module_interface_parin
614
615
616    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'start' )
617
618    CALL dynamics_parin
619
620    CALL bio_parin
621    CALL bcm_parin
622    CALL chem_parin
623    CALL flight_parin ! ToDo: rename module to match filename
624    CALL gust_parin
625    CALL im_parin
626    CALL lpm_parin
627    CALL lsm_parin
628    ! ToDo: create parin routine for large_scale_forcing and nudging (should be seperate modules or new module switch)
629    CALL mas_parin
630    CALL nesting_offl_parin
631    CALL ocean_parin
632    CALL pcm_parin
633    CALL radiation_parin
634    CALL salsa_parin
635    CALL spectra_parin
636    CALL surface_data_output_parin
637    CALL stg_parin
638    CALL usm_parin
639    CALL vm_parin
640    CALL wtm_parin
641
642    CALL user_parin
643
644    IF ( debug_output )  CALL debug_message( 'reading module-specific parameters', 'end' )
645
646
647 END SUBROUTINE module_interface_parin
648
649
650!------------------------------------------------------------------------------!
651! Description:
652! ------------
653!> Perform module-specific initialization checks
654!------------------------------------------------------------------------------!
655 SUBROUTINE module_interface_check_parameters
656
657
658    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'start' )
659
660    CALL dynamics_check_parameters
661
662    IF ( bulk_cloud_model )     CALL bcm_check_parameters
663    IF ( air_chemistry )        CALL chem_check_parameters
664    IF ( gust_module_enabled )  CALL gust_check_parameters
665    IF ( indoor_model )         CALL im_check_parameters
666    IF ( particle_advection )   CALL lpm_check_parameters
667    IF ( land_surface )         CALL lsm_check_parameters
668    IF ( large_scale_forcing  .OR.  nudging )  CALL lsf_nudging_check_parameters ! ToDo: create single module switch
669    IF ( nesting_offline )      CALL nesting_offl_check_parameters
670    IF ( ocean_mode )           CALL ocean_check_parameters
671    IF ( plant_canopy )         CALL pcm_check_parameters
672    IF ( radiation )            CALL radiation_check_parameters
673    IF ( salsa )                CALL salsa_check_parameters
674    IF ( calculate_spectra )    CALL spectra_check_parameters
675    IF ( surface_output )       CALL surface_data_output_check_parameters
676    IF ( syn_turb_gen )         CALL stg_check_parameters
677    IF ( urban_surface )        CALL usm_check_parameters
678    IF ( virtual_measurement )  CALL vm_check_parameters
679    IF ( wind_turbine )         CALL wtm_check_parameters
680
681    IF ( user_module_enabled )  CALL user_check_parameters
682
683    IF ( debug_output )  CALL debug_message( 'checking module-specific parameters', 'end' )
684
685
686 END SUBROUTINE module_interface_check_parameters
687
688
689!------------------------------------------------------------------------------!
690! Description:
691! ------------
692!> Check module-specific data output of timeseries
693!------------------------------------------------------------------------------!
694 SUBROUTINE module_interface_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
695
696
697    INTEGER(iwp),      INTENT(IN)    ::  dots_max !< variable output array index
698    INTEGER(iwp),      INTENT(INOUT)    ::  dots_num !< variable output array index
699    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
700    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
701
702
703    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'start' )
704
705    CALL dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
706
707    IF ( radiation )  THEN
708       CALL radiation_check_data_output_ts( dots_max, dots_num )
709    ENDIF
710
711    IF ( user_module_enabled )  THEN
712       CALL user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
713    ENDIF
714
715    IF ( debug_output )  CALL debug_message( 'checking module-specific data output ts', 'end' )
716
717
718 END SUBROUTINE module_interface_check_data_output_ts
719
720
721!------------------------------------------------------------------------------!
722! Description:
723! ------------
724!> Check module-specific data output of profiles
725!------------------------------------------------------------------------------!
726 SUBROUTINE module_interface_check_data_output_pr( variable, var_count, unit,  &
727                                                   dopr_unit )
728
729
730    CHARACTER (LEN=*), INTENT(IN)    ::  variable  !< variable name
731    INTEGER(iwp),      INTENT(IN)    ::  var_count !< variable output array index
732    CHARACTER (LEN=*), INTENT(INOUT) ::  unit      !< physical unit of variable
733    CHARACTER (LEN=*), INTENT(OUT)   ::  dopr_unit !< local value of dopr_unit
734
735
736    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'start' )
737
738    CALL dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit )
739
740    IF ( unit == 'illegal' .AND.  bulk_cloud_model )  THEN
741       CALL bcm_check_data_output_pr( variable, var_count, unit, dopr_unit )
742    ENDIF
743
744    IF ( unit == 'illegal' .AND.  air_chemistry )  THEN
745       CALL chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
746    ENDIF
747
748    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
749       CALL gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
750    ENDIF
751
752    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
753       CALL lsm_check_data_output_pr( variable, var_count, unit, dopr_unit )
754    ENDIF
755
756    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
757       CALL lsf_nudging_check_data_output_pr( variable, var_count, unit, dopr_unit )
758    ENDIF
759
760    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
761       CALL ocean_check_data_output_pr( variable, var_count, unit, dopr_unit )
762    ENDIF
763
764    IF ( unit == 'illegal'  .AND.  radiation )  THEN
765       CALL radiation_check_data_output_pr( variable, var_count, unit, dopr_unit )
766    ENDIF
767
768    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
769       unit = '' ! ToDo: Seems like a hack. Find a general soultion!
770       CALL user_check_data_output_pr( variable, var_count, unit, dopr_unit )
771    ENDIF
772
773    IF ( debug_output )  CALL debug_message( 'checking module-specific data output pr', 'end' )
774
775
776 END SUBROUTINE module_interface_check_data_output_pr
777
778!------------------------------------------------------------------------------!
779! Description:
780! ------------
781!> Check module-specific 2D and 3D data output
782!------------------------------------------------------------------------------!
783 SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k )
784
785
786    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
787    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
788
789    INTEGER(iwp),      INTENT(IN)    :: i         !< ToDo: remove dummy argument, instead pass string from data_output
790    INTEGER(iwp),      INTENT(IN)    :: j         !< average quantity? 0 = no, 1 = yes
791    INTEGER(iwp),      INTENT(IN)    :: ilen      !< ToDo: remove dummy argument, instead pass string from data_output
792    INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
793
794
795    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'start' )
796
797    CALL dynamics_check_data_output( variable, unit )
798
799    IF ( unit == 'illegal'  .AND.  biometeorology )  THEN
800       CALL bio_check_data_output( variable, unit, i, j, ilen, k )
801    ENDIF
802
803    IF ( unit == 'illegal'  .AND.  bulk_cloud_model  )  THEN
804       CALL bcm_check_data_output( variable, unit )
805    ENDIF
806
807    IF ( unit == 'illegal'  .AND.  air_chemistry                               &
808         .AND.  (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
809       CALL chem_check_data_output( variable, unit, i, ilen, k )
810    ENDIF
811
812    IF ( unit == 'illegal' )  THEN
813       CALL doq_check_data_output( variable, unit )
814    ENDIF
815
816    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
817       CALL gust_check_data_output( variable, unit )
818    ENDIF
819
820    IF ( unit == 'illegal' )  THEN  ! ToDo: add module switch if possible
821       CALL lsm_check_data_output( variable, unit, i, ilen, k )
822    ENDIF
823
824    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
825       CALL ocean_check_data_output( variable, unit )
826    ENDIF
827
828    IF ( unit == 'illegal'  .AND.  plant_canopy                                &
829         .AND.  variable(1:4) == 'pcm_' )  THEN  ! ToDo: remove aditional conditions
830       CALL pcm_check_data_output( variable, unit )
831    ENDIF
832
833    IF ( unit == 'illegal'  .AND.  radiation )  THEN
834       CALL radiation_check_data_output( variable, unit, i, ilen, k )
835    ENDIF
836
837    IF ( unit == 'illegal' .AND. salsa ) THEN
838       CALL salsa_check_data_output( variable, unit )
839    ENDIF
840
841    IF ( unit == 'illegal' .AND. indoor_model ) THEN
842       CALL im_check_data_output( variable, unit )
843    ENDIF
844
845    IF ( unit == 'illegal'  .AND.  urban_surface                      &
846        .AND.  variable(1:4) == 'usm_' )  THEN  ! ToDo: remove aditional conditions
847       CALL usm_check_data_output( variable, unit )
848    ENDIF
849
850    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
851       unit = ''
852       CALL user_check_data_output( variable, unit )
853    ENDIF
854
855    IF ( debug_output )  CALL debug_message( 'checking module-specific data output 2d/3d', 'end' )
856
857
858 END SUBROUTINE module_interface_check_data_output
859
860
861!------------------------------------------------------------------------------!
862!
863! Description:
864! ------------
865!> Interface for init_masks. ToDo: get rid of these redundant calls!
866!------------------------------------------------------------------------------!
867 SUBROUTINE module_interface_init_masks( variable, unit )
868
869
870    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
871    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
872
873
874    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'start' )
875
876    CALL dynamics_init_masks( variable, unit )
877
878    IF ( unit == 'illegal'  .AND.  air_chemistry                               &
879         .AND.  (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
880       CALL chem_check_data_output( variable, unit, 0, 0, 0 )
881    ENDIF
882
883    IF ( unit == 'illegal'  .AND.  radiation )  THEN
884       CALL radiation_check_data_output( variable, unit, 0, 0, 0 )
885    ENDIF
886
887    IF ( unit == 'illegal'  .AND.  salsa )  THEN
888       CALL salsa_check_data_output( variable, unit )
889    ENDIF
890
891    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
892       unit = ''
893       CALL user_check_data_output( variable, unit )
894    ENDIF
895
896    IF ( debug_output )  CALL debug_message( 'initializing module-specific masks', 'end' )
897
898
899 END SUBROUTINE module_interface_init_masks
900
901
902!------------------------------------------------------------------------------!
903!
904! Description:
905! ------------
906!> Define appropriate grid for module-specific netcdf output variables.
907!------------------------------------------------------------------------------!
908 SUBROUTINE module_interface_define_netcdf_grid( var, found,                   &
909                                                 grid_x, grid_y, grid_z )
910
911
912    CHARACTER (LEN=*), INTENT(IN)  ::  var    !< variable name
913    LOGICAL,           INTENT(OUT) ::  found  !< indicates if variable was found
914    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x !< netcdf dimension in x-direction
915    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y !< netcdf dimension in y-direction
916    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z !< netcdf dimension in z-direction
917
918
919    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'start' )
920!
921!-- As long as no action is done in this subroutine, initialize strings with
922!-- intent(out) attribute, in order to avoid compiler warnings.
923    found  = .FALSE.
924    grid_x = 'none'
925    grid_y = 'none'
926    grid_z = 'none'
927!
928!-- Use var to avoid compiler warning about unused variable
929    IF ( var == ' ' )  RETURN
930
931    IF ( debug_output )  CALL debug_message( 'defining module-specific netcdf grids', 'end' )
932
933
934 END SUBROUTINE module_interface_define_netcdf_grid
935
936
937!------------------------------------------------------------------------------!
938! Description:
939! ------------
940!> Allocate module-specific arrays and pointers
941!------------------------------------------------------------------------------!
942 SUBROUTINE module_interface_init_arrays
943
944
945    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'start' )
946
947    CALL dynamics_init_arrays
948
949    IF ( bulk_cloud_model    )  CALL bcm_init_arrays
950    IF ( air_chemistry       )  CALL chem_init_arrays
951    IF ( gust_module_enabled )  CALL gust_init_arrays
952    IF ( particle_advection  )  CALL lpm_init_arrays
953    IF ( land_surface        )  CALL lsm_init_arrays
954    IF ( ocean_mode          )  CALL ocean_init_arrays
955    IF ( salsa               )  CALL salsa_init_arrays
956    IF ( urban_surface       )  CALL usm_init_arrays
957    IF ( surface_output      )  CALL surface_data_output_init_arrays
958    IF ( wind_turbine        )  CALL wtm_init_arrays
959
960    IF ( user_module_enabled )  CALL user_init_arrays
961
962    IF ( debug_output )  CALL debug_message( 'initializing module-specific arrays', 'end' )
963
964
965 END SUBROUTINE module_interface_init_arrays
966
967
968!------------------------------------------------------------------------------!
969! Description:
970! ------------
971!> Perform module-specific initialization
972!------------------------------------------------------------------------------!
973 SUBROUTINE module_interface_init
974
975
976    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'start' )
977
978    CALL dynamics_init
979
980    IF ( biometeorology      )  CALL bio_init
981    IF ( bulk_cloud_model    )  CALL bcm_init
982    IF ( air_chemistry       )  CALL chem_init
983    IF ( virtual_flight      )  CALL flight_init
984    IF ( gust_module_enabled )  CALL gust_init
985    IF ( indoor_model        )  CALL im_init
986    IF ( particle_advection  )  CALL lpm_init
987    IF ( large_scale_forcing )  CALL lsf_init
988    IF ( land_surface        )  CALL lsm_init
989    IF ( nudging             )  CALL nudge_init
990    IF ( ocean_mode          )  CALL ocean_init
991    IF ( plant_canopy        )  CALL pcm_init
992    IF ( salsa               )  CALL salsa_init
993    IF ( urban_surface       )  CALL usm_init
994    IF ( virtual_measurement )  CALL vm_init
995    IF ( wind_turbine        )  CALL wtm_init
996    IF ( radiation           )  CALL radiation_init
997
998    IF ( user_module_enabled )  CALL user_init
999
1000    IF ( debug_output )  CALL debug_message( 'module-specific initialization', 'end' )
1001
1002
1003 END SUBROUTINE module_interface_init
1004
1005
1006!------------------------------------------------------------------------------!
1007! Description:
1008! ------------
1009!> Perform module-specific post-initialization checks
1010!------------------------------------------------------------------------------!
1011 SUBROUTINE module_interface_init_checks
1012
1013
1014    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'start' )
1015
1016    CALL dynamics_init_checks
1017
1018    IF ( biometeorology      )  CALL bio_init_checks
1019
1020    IF ( debug_output )  CALL debug_message( 'module-specific post-initialization checks', 'end' )
1021
1022
1023 END SUBROUTINE module_interface_init_checks
1024
1025
1026!------------------------------------------------------------------------------!
1027! Description:
1028! ------------
1029!> Gather module-specific header output
1030!------------------------------------------------------------------------------!
1031 SUBROUTINE module_interface_header( io )
1032
1033
1034    INTEGER(iwp), INTENT(IN) ::  io  !< unit of the output file
1035
1036
1037    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'start' )
1038
1039    CALL dynamics_header( io )
1040
1041    IF ( biometeorology      )  CALL bio_header ( io )
1042    IF ( bulk_cloud_model    )  CALL bcm_header( io )
1043    IF ( air_chemistry       )  CALL chem_header ( io )
1044    IF ( virtual_flight      )  CALL flight_header( io )
1045    IF ( gust_module_enabled )  CALL gust_header( io )
1046    IF ( particle_advection  )  CALL lpm_header( io )
1047    IF ( land_surface        )  CALL lsm_header( io )
1048    IF ( large_scale_forcing )  CALL lsf_nudging_header( io )
1049    IF ( nesting_offline     )  CALL nesting_offl_header( io )
1050    IF ( ocean_mode          )  CALL ocean_header( io )
1051    IF ( plant_canopy        )  CALL pcm_header( io )
1052    IF ( radiation           )  CALL radiation_header( io )
1053    IF ( salsa               )  CALL salsa_header( io )
1054    IF ( calculate_spectra   )  CALL spectra_header( io )
1055    IF ( syn_turb_gen        )  CALL stg_header( io )
1056
1057    IF ( user_module_enabled )  CALL user_header( io )
1058
1059    IF ( debug_output )  CALL debug_message( 'module-specific header output', 'end' )
1060
1061
1062 END SUBROUTINE module_interface_header
1063
1064
1065!------------------------------------------------------------------------------!
1066! Description:
1067! ------------
1068!> Perform module-specific actions while in time-integration (vector-optimized)
1069!------------------------------------------------------------------------------!
1070 SUBROUTINE module_interface_actions( location )
1071
1072
1073    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
1074
1075    CALL dynamics_actions( location )
1076
1077    IF ( bulk_cloud_model    )  CALL bcm_actions( location )
1078    IF ( air_chemistry       )  CALL chem_actions( location )
1079    IF ( gust_module_enabled )  CALL gust_actions( location )
1080    IF ( particle_advection  )  CALL lpm_actions( location )
1081    IF ( ocean_mode          )  CALL ocean_actions( location )
1082    IF ( salsa               )  CALL salsa_actions( location )
1083    IF ( wind_turbine        )  CALL wtm_actions( location )
1084
1085    IF ( user_module_enabled )  CALL user_actions( location )
1086
1087
1088 END SUBROUTINE module_interface_actions
1089
1090
1091!------------------------------------------------------------------------------!
1092! Description:
1093! ------------
1094!> Perform module-specific actions while in time-integration (cache-optimized)
1095!------------------------------------------------------------------------------!
1096 SUBROUTINE module_interface_actions_ij( i, j, location )
1097
1098
1099    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
1100    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
1101    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
1102
1103    CALL dynamics_actions( i, j, location )
1104
1105    IF ( bulk_cloud_model    )  CALL bcm_actions( i, j, location )
1106    IF ( air_chemistry       )  CALL chem_actions( i, j, location )
1107    IF ( gust_module_enabled )  CALL gust_actions( i, j, location )
1108    IF ( ocean_mode          )  CALL ocean_actions( i, j, location )
1109    IF ( salsa               )  CALL salsa_actions( i, j, location )
1110    IF ( wind_turbine        )  CALL wtm_actions( i, j, location )
1111
1112    IF ( user_module_enabled )  CALL user_actions( i, j, location )
1113
1114
1115 END SUBROUTINE module_interface_actions_ij
1116
1117
1118!------------------------------------------------------------------------------!
1119! Description:
1120! ------------
1121!> Compute module-specific non_advective_processes (vector-optimized)
1122!------------------------------------------------------------------------------!
1123 SUBROUTINE module_interface_non_advective_processes
1124
1125
1126    CALL dynamics_non_advective_processes
1127
1128    IF ( bulk_cloud_model    )  CALL bcm_non_advective_processes
1129    IF ( air_chemistry       )  CALL chem_non_advective_processes
1130    IF ( salsa               )  CALL salsa_non_advective_processes
1131
1132
1133 END SUBROUTINE module_interface_non_advective_processes
1134
1135
1136!------------------------------------------------------------------------------!
1137! Description:
1138! ------------
1139!> Compute module-specific non_advective_processes (cache-optimized)
1140!------------------------------------------------------------------------------!
1141 SUBROUTINE module_interface_non_advective_processes_ij( i, j )
1142
1143
1144    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
1145    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
1146
1147    CALL dynamics_non_advective_processes( i, j )
1148
1149    IF ( bulk_cloud_model    )  CALL bcm_non_advective_processes( i, j )
1150    IF ( air_chemistry       )  CALL chem_non_advective_processes( i, j )
1151    IF ( salsa               )  CALL salsa_non_advective_processes( i, j )
1152
1153
1154 END SUBROUTINE module_interface_non_advective_processes_ij
1155
1156!------------------------------------------------------------------------------!
1157! Description:
1158! ------------
1159!> Exchange horiz for module-specific quantities
1160!------------------------------------------------------------------------------!
1161 SUBROUTINE module_interface_exchange_horiz
1162
1163
1164    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'start' )
1165
1166    CALL dynamics_exchange_horiz
1167
1168    IF ( bulk_cloud_model    )  CALL bcm_exchange_horiz
1169    IF ( air_chemistry       )  CALL chem_exchange_horiz_bounds
1170    IF ( salsa               )  CALL salsa_exchange_horiz_bounds
1171
1172    IF ( debug_output_timestep )  CALL debug_message( 'module-specific exchange_horiz', 'end' )
1173
1174
1175 END SUBROUTINE module_interface_exchange_horiz
1176
1177
1178!------------------------------------------------------------------------------!
1179! Description:
1180! ------------
1181!> Compute module-specific prognostic_equations (vector-optimized)
1182!------------------------------------------------------------------------------!
1183 SUBROUTINE module_interface_prognostic_equations
1184
1185
1186    CALL dynamics_prognostic_equations
1187
1188    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations
1189    IF ( air_chemistry       )  CALL chem_prognostic_equations
1190    IF ( gust_module_enabled )  CALL gust_prognostic_equations
1191    IF ( ocean_mode          )  CALL ocean_prognostic_equations
1192    IF ( salsa               )  CALL salsa_prognostic_equations
1193
1194
1195 END SUBROUTINE module_interface_prognostic_equations
1196
1197
1198!------------------------------------------------------------------------------!
1199! Description:
1200! ------------
1201!> Compute module-specific prognostic_equations (cache-optimized)
1202!------------------------------------------------------------------------------!
1203 SUBROUTINE module_interface_prognostic_equations_ij( i, j, i_omp_start, tn )
1204
1205
1206    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
1207    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
1208    INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
1209    INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
1210
1211    CALL dynamics_prognostic_equations( i, j, i_omp_start, tn )
1212
1213    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations( i, j, i_omp_start, tn )
1214    IF ( air_chemistry       )  CALL chem_prognostic_equations( i, j, i_omp_start, tn )
1215    IF ( gust_module_enabled )  CALL gust_prognostic_equations( i, j, i_omp_start, tn )
1216    IF ( ocean_mode          )  CALL ocean_prognostic_equations( i, j, i_omp_start, tn )
1217    IF ( salsa               )  CALL salsa_prognostic_equations( i, j, i_omp_start, tn )
1218
1219
1220 END SUBROUTINE module_interface_prognostic_equations_ij
1221
1222
1223!------------------------------------------------------------------------------!
1224! Description:
1225! ------------
1226!> Swap the timelevel pointers for module-specific arrays
1227!------------------------------------------------------------------------------!
1228 SUBROUTINE module_interface_swap_timelevel ( swap_mode )
1229
1230
1231    INTEGER(iwp), INTENT(IN) :: swap_mode !< determines procedure of pointer swap
1232
1233
1234    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'start' )
1235
1236    CALL dynamics_swap_timelevel( swap_mode )
1237    CALL tcm_swap_timelevel( swap_mode )
1238
1239    IF ( bulk_cloud_model    )  CALL bcm_swap_timelevel( swap_mode )
1240    IF ( air_chemistry       )  CALL chem_swap_timelevel( swap_mode )
1241    IF ( gust_module_enabled )  CALL gust_swap_timelevel( swap_mode )
1242    IF ( land_surface        )  CALL lsm_swap_timelevel( swap_mode )
1243    IF ( ocean_mode          )  CALL ocean_swap_timelevel( swap_mode )
1244    IF ( salsa               )  CALL salsa_swap_timelevel( swap_mode )
1245    IF ( urban_surface       )  CALL usm_swap_timelevel( swap_mode )
1246
1247    IF ( debug_output_timestep )  CALL debug_message( 'module-specific swap timelevel', 'end' )
1248
1249
1250 END SUBROUTINE module_interface_swap_timelevel
1251
1252
1253!------------------------------------------------------------------------------!
1254!
1255! Description:
1256! ------------
1257!> Perform module-specific averaging of 3D data
1258!------------------------------------------------------------------------------!
1259 SUBROUTINE module_interface_3d_data_averaging( mode, variable )
1260
1261
1262    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< averaging interface mode
1263    CHARACTER (LEN=*), INTENT(IN) ::  variable !< variable name
1264
1265
1266    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'start' )
1267
1268    CALL dynamics_3d_data_averaging( mode, variable )
1269
1270    IF ( biometeorology      )  CALL bio_3d_data_averaging( mode, variable )
1271    IF ( bulk_cloud_model    )  CALL bcm_3d_data_averaging( mode, variable )
1272    IF ( air_chemistry       )  CALL chem_3d_data_averaging( mode, variable )
1273    CALL doq_3d_data_averaging( mode, variable )  ! ToDo: this seems to be not according to the design
1274    IF ( gust_module_enabled )  CALL gust_3d_data_averaging( mode, variable )
1275    IF ( land_surface        )  CALL lsm_3d_data_averaging( mode, variable )
1276    IF ( ocean_mode          )  CALL ocean_3d_data_averaging( mode, variable )
1277    IF ( radiation           )  CALL radiation_3d_data_averaging( mode, variable )
1278    IF ( salsa               )  CALL salsa_3d_data_averaging( mode, variable )
1279    IF ( urban_surface       )  CALL usm_3d_data_averaging( mode, variable )
1280
1281    IF ( user_module_enabled )  CALL user_3d_data_averaging( mode, variable )
1282
1283    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data averaging', 'end' )
1284
1285
1286 END SUBROUTINE module_interface_3d_data_averaging
1287
1288!------------------------------------------------------------------------------!
1289!
1290! Description:
1291! ------------
1292!> Define module-specific 2D output variables
1293!------------------------------------------------------------------------------!
1294 SUBROUTINE module_interface_data_output_2d( av, variable, found, grid, mode,  &
1295                                             local_pf, two_d, nzb_do, nzt_do,  &
1296                                             fill_value )
1297
1298    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
1299    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
1300    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
1301    CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
1302    CHARACTER (LEN=*), INTENT(IN)    ::  mode       !< either 'xy', 'xz' or 'yz'
1303    LOGICAL,           INTENT(OUT)   ::  two_d      !< flag for 2D variables
1304    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
1305    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
1306    REAL(wp),          INTENT(IN)    ::  fill_value !< to be removed
1307
1308    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf !< ToDo: can also be kind=sp
1309
1310
1311    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'start' )
1312
1313    CALL dynamics_data_output_2d(                                                  &
1314               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, fill_value &
1315            )
1316
1317    IF ( .NOT. found  .AND.  biometeorology )  THEN
1318       CALL bio_data_output_2d(                                                &
1319               av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do      &
1320            )
1321    ENDIF
1322
1323    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
1324       CALL bcm_data_output_2d(                                                &
1325               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1326            )
1327    ENDIF
1328
1329    IF ( .NOT. found  .AND.  air_chemistry )  THEN
1330       CALL chem_data_output_2d(                                               &
1331               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, fill_value &
1332            )
1333    ENDIF
1334
1335    IF ( .NOT. found )  THEN
1336       CALL doq_output_2d(                                                     &
1337               av, variable, found, grid, mode, local_pf, two_d,               &
1338               nzb_do, nzt_do, fill_value )
1339    ENDIF
1340
1341    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1342       CALL gust_data_output_2d(                                               &
1343               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, fill_value &
1344            )
1345    ENDIF
1346
1347    IF ( .NOT. found  .AND.  land_surface )  THEN
1348       CALL lsm_data_output_2d(                                                &
1349               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1350            )
1351    ENDIF
1352
1353    IF ( .NOT. found  .AND.  ocean_mode )  THEN
1354       CALL ocean_data_output_2d(                                              &
1355               av, variable, found, grid, mode, local_pf, nzb_do, nzt_do       &
1356            )
1357    ENDIF
1358
1359    IF ( .NOT. found  .AND.  radiation )  THEN
1360       CALL radiation_data_output_2d(                                          &
1361               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1362            )
1363    ENDIF
1364
1365    IF ( .NOT. found  .AND.  salsa )  THEN
1366       CALL salsa_data_output_2d(                                              &
1367               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1368            )
1369    ENDIF
1370
1371    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1372       CALL user_data_output_2d(                                               &
1373               av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do      &
1374            )
1375    ENDIF
1376
1377    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 2d data output', 'end' )
1378
1379
1380 END SUBROUTINE module_interface_data_output_2d
1381
1382
1383!------------------------------------------------------------------------------!
1384!
1385! Description:
1386! ------------
1387!> Define module-specific 3D output variables
1388!------------------------------------------------------------------------------!
1389 SUBROUTINE module_interface_data_output_3d( av, variable, found, local_pf,    &
1390                                             fill_value, resorted, nzb_do, nzt_do )
1391
1392
1393    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
1394    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
1395    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
1396    REAL(wp),          INTENT(IN)    ::  fill_value !< ToDo: refactor
1397    LOGICAL,           INTENT(OUT)   ::  resorted   !< flag if output has been resorted
1398    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
1399    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
1400
1401    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(INOUT) ::  local_pf
1402
1403
1404    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'start' )
1405
1406    CALL dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1407    resorted = .FALSE.
1408
1409    IF ( .NOT. found  .AND.  biometeorology )  THEN
1410       CALL bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1411       resorted = .FALSE.
1412    ENDIF
1413
1414    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
1415       CALL bcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1416       resorted = .TRUE.
1417    ENDIF
1418
1419    IF ( .NOT. found  .AND.  air_chemistry )  THEN
1420       CALL chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1421       resorted = .TRUE.
1422    ENDIF
1423
1424    IF ( .NOT. found )  THEN
1425       CALL doq_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1426       resorted = .TRUE.
1427    ENDIF
1428
1429    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1430       CALL gust_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1431       resorted = .TRUE.
1432    ENDIF
1433
1434    IF ( .NOT. found  .AND.  indoor_model )  THEN
1435       CALL im_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1436       resorted = .TRUE.
1437    ENDIF
1438
1439    IF ( .NOT. found  .AND.  ocean_mode )  THEN
1440       CALL ocean_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1441       resorted = .TRUE.
1442    ENDIF
1443
1444    IF ( .NOT. found  .AND.  plant_canopy )  THEN
1445       CALL pcm_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1446       resorted = .TRUE.
1447    ENDIF
1448
1449    IF ( .NOT. found  .AND.  radiation )  THEN
1450       CALL radiation_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1451       resorted = .TRUE.
1452    ENDIF
1453
1454    IF ( .NOT. found  .AND.  salsa )  THEN
1455       CALL salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1456       resorted = .TRUE.
1457    ENDIF
1458
1459    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1460       CALL user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1461       resorted = .TRUE.
1462    ENDIF
1463
1464    IF ( debug_output_timestep )  CALL debug_message( 'module-specific 3d data output', 'end' )
1465
1466
1467 END SUBROUTINE module_interface_data_output_3d
1468
1469
1470!------------------------------------------------------------------------------!
1471! Description:
1472! ------------
1473!> Compute module-specific profile and timeseries data
1474!------------------------------------------------------------------------------!
1475 SUBROUTINE module_interface_statistics( mode, sr, tn, dots_max )
1476
1477
1478    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< statistical analysis mode
1479    INTEGER(iwp),      INTENT(IN) ::  sr       !<
1480    INTEGER(iwp),      INTENT(IN) ::  tn       !<
1481    INTEGER(iwp),      INTENT(IN) ::  dots_max !< maximum number of timeseries
1482
1483
1484    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'start' )
1485
1486    CALL dynamics_statistics( mode, sr, tn )
1487
1488    IF ( gust_module_enabled )  CALL gust_statistics( mode, sr, tn, dots_max )
1489    IF ( air_chemistry       )  CALL chem_statistics( mode, sr, tn )
1490
1491    IF ( user_module_enabled )  CALL user_statistics( mode, sr, tn )
1492
1493    IF ( debug_output_timestep )  CALL debug_message( 'module-specific statistics', 'end' )
1494
1495
1496 END SUBROUTINE module_interface_statistics
1497
1498
1499!------------------------------------------------------------------------------!
1500! Description:
1501! ------------
1502!> Read module-specific restart data globaly shared by all MPI ranks
1503!------------------------------------------------------------------------------!
1504 SUBROUTINE module_interface_rrd_global( found )
1505
1506
1507    LOGICAL, INTENT(INOUT) ::  found    !< flag if variable was found
1508
1509
1510    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'start' )
1511
1512    CALL dynamics_rrd_global( found ) ! ToDo: change interface to pass variable
1513
1514    IF ( .NOT. found )  CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable
1515    IF ( .NOT. found )  CALL bcm_rrd_global( found ) ! ToDo: change interface to pass variable
1516    IF ( .NOT. found )  CALL flight_rrd_global( found ) ! ToDo: change interface to pass variable
1517    IF ( .NOT. found )  CALL gust_rrd_global( found ) ! ToDo: change interface to pass variable
1518    IF ( .NOT. found )  CALL lpm_rrd_global( found ) ! ToDo: change interface to pass variable
1519    IF ( .NOT. found )  CALL ocean_rrd_global( found ) ! ToDo: change interface to pass variable
1520    IF ( .NOT. found )  CALL stg_rrd_global ( found ) ! ToDo: change interface to pass variable
1521    IF ( .NOT. found )  CALL wtm_rrd_global( found ) ! ToDo: change interface to pass variable
1522    IF ( .NOT. found )  CALL surface_data_output_rrd_global( found )
1523
1524    IF ( .NOT. found )  CALL user_rrd_global( found ) ! ToDo: change interface to pass variable
1525
1526    IF ( debug_output )  CALL debug_message( 'module-specific read global restart data', 'end' )
1527
1528
1529 END SUBROUTINE module_interface_rrd_global
1530
1531
1532!------------------------------------------------------------------------------!
1533! Description:
1534! ------------
1535!> Write module-specific restart data globaly shared by all MPI ranks
1536!------------------------------------------------------------------------------!
1537 SUBROUTINE module_interface_wrd_global
1538
1539
1540    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'start' )
1541
1542    CALL dynamics_wrd_global
1543
1544    IF ( biometeorology )       CALL bio_wrd_global
1545    IF ( bulk_cloud_model )     CALL bcm_wrd_global
1546    IF ( virtual_flight )       CALL flight_wrd_global
1547    IF ( gust_module_enabled )  CALL gust_wrd_global
1548    IF ( ocean_mode )           CALL ocean_wrd_global
1549    IF ( syn_turb_gen )         CALL stg_wrd_global
1550    IF ( wind_turbine )         CALL wtm_wrd_global
1551    IF ( surface_output )       CALL surface_data_output_wrd_global
1552
1553    IF ( user_module_enabled )  CALL user_wrd_global
1554
1555    IF ( debug_output )  CALL debug_message( 'module-specific write global restart data', 'end' )
1556
1557
1558 END SUBROUTINE module_interface_wrd_global
1559
1560
1561!------------------------------------------------------------------------------!
1562! Description:
1563! ------------
1564!> Read module-specific restart data specific to local MPI ranks
1565!------------------------------------------------------------------------------!
1566 SUBROUTINE module_interface_rrd_local( map_index,                             &
1567                                        nxlf, nxlc, nxl_on_file,               &
1568                                        nxrf, nxrc, nxr_on_file,               &
1569                                        nynf, nync, nyn_on_file,               &
1570                                        nysf, nysc, nys_on_file,               &
1571                                        tmp_2d, tmp_3d, found )
1572
1573
1574    INTEGER(iwp), INTENT(IN)  ::  map_index    !<
1575    INTEGER(iwp), INTENT(IN)  ::  nxlc         !<
1576    INTEGER(iwp), INTENT(IN)  ::  nxlf         !<
1577    INTEGER(iwp), INTENT(IN)  ::  nxl_on_file  !<
1578    INTEGER(iwp), INTENT(IN)  ::  nxrc         !<
1579    INTEGER(iwp), INTENT(IN)  ::  nxrf         !<
1580    INTEGER(iwp), INTENT(IN)  ::  nxr_on_file  !<
1581    INTEGER(iwp), INTENT(IN)  ::  nync         !<
1582    INTEGER(iwp), INTENT(IN)  ::  nynf         !<
1583    INTEGER(iwp), INTENT(IN)  ::  nyn_on_file  !<
1584    INTEGER(iwp), INTENT(IN)  ::  nysc         !<
1585    INTEGER(iwp), INTENT(IN)  ::  nysf         !<
1586    INTEGER(iwp), INTENT(IN)  ::  nys_on_file  !<
1587    LOGICAL,      INTENT(INOUT) ::  found        !< flag if variable was found
1588
1589    REAL(wp), &
1590       DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp), &
1591       INTENT(OUT) :: tmp_2d   !<
1592    REAL(wp), &
1593       DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp), &
1594       INTENT(OUT) :: tmp_3d   !<
1595
1596
1597    IF ( debug_output )  CALL debug_message( 'module-specific read local restart data', 'start' )
1598
1599    CALL dynamics_rrd_local(                                                   &
1600           map_index,                                                          &
1601           nxlf, nxlc, nxl_on_file,                                            &
1602           nxrf, nxrc, nxr_on_file,                                            &
1603           nynf, nync, nyn_on_file,                                            &
1604           nysf, nysc, nys_on_file,                                            &
1605           tmp_2d, tmp_3d, found                                               &
1606        ) ! ToDo: change interface to pass variable
1607
1608    IF ( .NOT. found )  CALL bio_rrd_local(                                    &
1609                               found                                           &
1610                            )
1611
1612    IF ( .NOT. found )  CALL bcm_rrd_local(                                    &
1613                               map_index,                                      &
1614                               nxlf, nxlc, nxl_on_file,                        &
1615                               nxrf, nxrc, nxr_on_file,                        &
1616                               nynf, nync, nyn_on_file,                        &
1617                               nysf, nysc, nys_on_file,                        &
1618                               tmp_2d, tmp_3d, found                           &
1619                            ) ! ToDo: change interface to pass variable
1620
1621    IF ( .NOT. found )  CALL chem_rrd_local(                                   &
1622                               map_index,                                      &
1623                               nxlf, nxlc, nxl_on_file,                        &
1624                               nxrf, nxrc, nxr_on_file,                        &
1625                               nynf, nync, nyn_on_file,                        &
1626                               nysf, nysc, nys_on_file,                        &
1627                               tmp_3d, found                                   &
1628                            ) ! ToDo: change interface to pass variable
1629
1630!     IF ( .NOT. found )  CALL doq_rrd_local(                                    &
1631!                                map_index,                                      &
1632!                                nxlf, nxlc, nxl_on_file,                        &
1633!                                nxrf, nxrc, nxr_on_file,                        &
1634!                                nynf, nync, nyn_on_file,                        &
1635!                                nysf, nysc, nys_on_file,                        &
1636!                                tmp_3d_non_standard, found                      &
1637!                             ) ! ToDo: change interface to pass variable CALL doq_wrd_local
1638
1639    IF ( .NOT. found )  CALL gust_rrd_local(                                   &
1640                               map_index,                                      &
1641                               nxlf, nxlc, nxl_on_file,                        &
1642                               nxrf, nxrc, nxr_on_file,                        &
1643                               nynf, nync, nyn_on_file,                        &
1644                               nysf, nysc, nys_on_file,                        &
1645                               tmp_2d, tmp_3d, found                           &
1646                            ) ! ToDo: change interface to pass variable
1647
1648    IF ( .NOT. found )  CALL lpm_rrd_local(                                    &
1649                               map_index,                                      &
1650                               nxlf, nxlc, nxl_on_file,                        &
1651                               nxrf, nxrc, nxr_on_file,                        &
1652                               nynf, nync, nyn_on_file,                        &
1653                               nysf, nysc, nys_on_file,                        &
1654                               tmp_3d, found                                   &
1655                            ) ! ToDo: change interface to pass variable
1656
1657    IF ( .NOT. found )  CALL lsm_rrd_local(                                    &
1658                               map_index,                                      &
1659                               nxlf, nxlc, nxl_on_file,                        &
1660                               nxrf, nxrc, nxr_on_file,                        &
1661                               nynf, nync, nyn_on_file,                        &
1662                               nysf, nysc, nys_on_file,                        &
1663                               tmp_2d, found                                   &
1664                            ) ! ToDo: change interface to pass variable
1665
1666    IF ( .NOT. found )  CALL ocean_rrd_local(                                  &
1667                               map_index,                                      &
1668                               nxlf, nxlc, nxl_on_file,                        &
1669                               nxrf, nxrc, nxr_on_file,                        &
1670                               nynf, nync, nyn_on_file,                        &
1671                               nysf, nysc, nys_on_file,                        &
1672                               tmp_3d, found                                   &
1673                            ) ! ToDo: change interface to pass variable
1674
1675    IF ( .NOT. found )  CALL radiation_rrd_local(                              &
1676                               map_index,                                      &
1677                               nxlf, nxlc, nxl_on_file,                        &
1678                               nxrf, nxrc, nxr_on_file,                        &
1679                               nynf, nync, nyn_on_file,                        &
1680                               nysf, nysc, nys_on_file,                        &
1681                               tmp_2d, tmp_3d, found                           &
1682                            ) ! ToDo: change interface to pass variable
1683
1684    IF ( .NOT. found )  CALL salsa_rrd_local(                                  &
1685                               map_index,                                      &
1686                               nxlf, nxlc, nxl_on_file,                        &
1687                               nxrf, nxrc, nxr_on_file,                        &
1688                               nynf, nync, nyn_on_file,                        &
1689                               nysf, nysc, nys_on_file,                        &
1690                               tmp_3d, found                                   &
1691                            ) ! ToDo: change interface to pass variable
1692
1693    IF ( .NOT. found )  CALL usm_rrd_local(                                    &
1694                               map_index,                                      &
1695                               nxlf, nxlc, nxl_on_file,                        &
1696                               nxrf, nxr_on_file,                              &
1697                               nynf, nyn_on_file,                              &
1698                               nysf, nysc, nys_on_file,                        &
1699                               found                                           &
1700                            ) ! ToDo: change interface to pass variable
1701!
1702!-- Surface data do not need overlap data, so do not pass these information.
1703    IF ( .NOT. found )  CALL surface_data_output_rrd_local( found )
1704
1705    IF ( .NOT. found )  CALL user_rrd_local(                                   &
1706                               map_index,                                      &
1707                               nxlf, nxlc, nxl_on_file,                        &
1708                               nxrf, nxrc, nxr_on_file,                        &
1709                               nynf, nync, nyn_on_file,                        &
1710                               nysf, nysc, nys_on_file,                        &
1711                               tmp_3d, found                                   &
1712                            ) ! ToDo: change interface to pass variable
1713
1714    IF ( debug_output )  CALL debug_message( 'module-specific read local restart data', 'end' )
1715
1716
1717 END SUBROUTINE module_interface_rrd_local
1718
1719
1720!------------------------------------------------------------------------------!
1721! Description:
1722! ------------
1723!> Write module-specific restart data specific to local MPI ranks
1724!------------------------------------------------------------------------------!
1725 SUBROUTINE module_interface_wrd_local
1726
1727
1728    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'start' )
1729
1730    CALL dynamics_wrd_local
1731
1732    IF ( biometeorology )       CALL bio_wrd_local
1733    IF ( bulk_cloud_model )     CALL bcm_wrd_local
1734    IF ( air_chemistry )        CALL chem_wrd_local
1735    CALL doq_wrd_local
1736    IF ( gust_module_enabled )  CALL gust_wrd_local
1737    IF ( particle_advection )   CALL lpm_wrd_local
1738    IF ( land_surface )         CALL lsm_wrd_local
1739    IF ( ocean_mode )           CALL ocean_wrd_local
1740    IF ( radiation )            CALL radiation_wrd_local
1741    IF ( salsa )                CALL salsa_wrd_local
1742    IF ( urban_surface )        CALL usm_wrd_local
1743    IF ( surface_output )       CALL surface_data_output_wrd_local
1744
1745    IF ( user_module_enabled )  CALL user_wrd_local
1746
1747    IF ( debug_output )  CALL debug_message( 'module-specific write local restart data', 'end' )
1748
1749
1750 END SUBROUTINE module_interface_wrd_local
1751
1752
1753!------------------------------------------------------------------------------!
1754! Description:
1755! ------------
1756!> Perform module-specific last actions before the program terminates
1757!------------------------------------------------------------------------------!
1758 SUBROUTINE module_interface_last_actions
1759
1760
1761    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'start' )
1762
1763    CALL dynamics_last_actions
1764
1765    IF ( virtual_measurement )  CALL vm_last_actions
1766
1767    IF ( user_module_enabled )  CALL user_last_actions
1768
1769    IF ( debug_output )  CALL debug_message( 'module-specific last actions', 'end' )
1770
1771
1772 END SUBROUTINE module_interface_last_actions
1773
1774
1775 END MODULE module_interface
Note: See TracBrowser for help on using the repository browser.