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

Last change on this file since 4180 was 4180, checked in by scharf, 5 years ago

removed comments in 'Former revisions' section that are older than 01.01.2019

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