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

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

further modularization of boundary conditions: moving boundary conditions to their modules

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