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

Last change on this file since 4131 was 4131, checked in by monakurppa, 5 years ago

Several changes in the salsa aerosol module:

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