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

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

Moved turbulence_closure_mod calls into module_interface

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