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

Last change on this file since 4268 was 4268, checked in by schwenkel, 4 years ago

Introducing module interface for boundary conditions and move module specific boundary conditions into their modules

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