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

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

major changes in salsa: data input, format and performance

  • Time-dependent emissions enabled: lod=1 for yearly PM emissions that are normalised depending on the time, and lod=2 for preprocessed emissions (similar to the chemistry module).
  • Additionally, 'uniform' emissions allowed. This emission is set constant on all horisontal upward facing surfaces and it is created based on parameters surface_aerosol_flux, aerosol_flux_dpg/sigmag/mass_fracs_a/mass_fracs_b.
  • All emissions are now implemented as surface fluxes! No 3D sources anymore.
  • Update the emission information by calling salsa_emission_update if skip_time_do_salsa >= time_since_reference_point and next_aero_emission_update <= time_since_reference_point
  • Aerosol background concentrations read from PIDS_DYNAMIC. The vertical grid must match the one applied in the model.
  • Gas emissions and background concentrations can be also read in in salsa_mod if the chemistry module is not applied.
  • In deposition, information on the land use type can be now imported from the land use model
  • Use SI units in PARIN, i.e. n_lognorm given in #/m3 and dpg in metres.
  • Apply 100 character line limit
  • Change all variable names from capital to lowercase letter
  • Change real exponents to integer if possible. If not, precalculate the value of exponent
  • Rename in1a to start_subrange_1a, fn2a to end_subrange_1a etc.
  • Rename nbins --> nbins_aerosol, ncc_tot --> ncomponents_mass and ngast --> ngases_salsa
  • Rename ibc to index_bc, idu to index_du etc.
  • Renamed loop indices b, c and sg to ib, ic and ig
  • run_salsa subroutine removed
  • Corrected a bud in salsa_driver: falsely applied ino instead of inh
  • Call salsa_tendency within salsa_prognostic_equations which is called in module_interface_mod instead of prognostic_equations_mod
  • Removed tailing white spaces and unused variables
  • Change error message to start by PA instead of SA
  • Property svn:keywords set to Id
File size: 63.3 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 3864 2019-04-05 09:01:56Z monakurppa $
27! Add a call for salsa_prognostic_equations
28!
29! 3840 2019-03-29 10:35:52Z knoop
30! bugfix: intent of dummy arguments changed to inout
31!
32! 3770 2019-02-28 11:22:32Z moh.hefny
33! removed unused variables in module_interface_check_data_output_ts
34!
35! 3767 08:18:02Z raasch
36! unused variable file_index removed from subroutine parameter list
37!
38! 3766 2019-02-26 16:23:41Z raasch
39! first argument removed from module_interface_rrd_*, statement added to avoid
40! compiler warning about unused variable, file reformatted with respect to coding
41! standards
42!
43! 3762 2019-02-25 16:54:16Z suehring
44! only pass required arguments to surface_data_output_rrd_local
45!
46! 3747 2019-02-16 15:15:23Z gronemeier
47! Call user_init_arrays
48!
49! 3745 2019-02-15 18:57:56Z suehring
50! Add indoor model
51!
52! 3744 2019-02-15 18:38:58Z suehring
53! Removed bio_check_parameters as the method is empty.
54!
55! 3735 2019-02-12 09:52:40Z dom_dwd_user
56! Accepting variable j from check_parameters and passing it to
57! bio_check_data_output
58! Add required restart data for surface output module
59!
60! 3731 2019-02-11 13:06:27Z suehring
61! Add check_parameters routine for virtual measurements
62!
63! 3711 2019-01-31 13:44:26Z knoop
64! Introduced module_interface_init_checks for post-init checks
65!
66! 3705 2019-01-29 19:56:39Z suehring
67! Add last_actions for virtual measurements
68!
69! 3704 2019-01-29 19:51:41Z suehring
70! Some interface calls moved to module_interface + cleanup
71!
72! 3684 2019-01-20 20:20:58Z knoop
73! Bugfix: made unit intend INOUT
74!
75! 3650 2019-01-04 13:01:33Z kanani
76! Add restart routines for biometeorology
77!
78! 3649 2019-01-02 16:52:21Z suehring
79! Initialize strings, in order to avoid compiler warnings for non-initialized
80! characters with intent(out) attribute
81!
82! 3648 2019-01-02 16:35:46Z suehring
83! Rename subroutines for surface-data output
84!
85! 3641 2018-12-23 22:10:01Z knoop
86! Initial implementation of the PALM module interface
87!
88!
89! Description:
90! ------------
91!> This is the interface between the PALM model core and all its modules.
92!>
93!> @todo Re-format module to be consistent with coding standard
94!------------------------------------------------------------------------------!
95 MODULE module_interface
96
97    USE indices,                                                               &
98        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt
99
100    USE kinds
101
102!
103!-- load module-specific control parameters.
104!-- ToDo: move all of them to respective module or a dedicated central module
105    USE control_parameters,                                                    &
106        ONLY:  biometeorology,                                                 &
107               air_chemistry,                                                  &
108               indoor_model,                                                   &
109               land_surface,                                                   &
110               large_scale_forcing,                                            &
111               nesting_offline,                                                &
112               nudging,                                                        &
113               ocean_mode,                                                     &
114               plant_canopy,                                                   &
115               salsa,                                                          &
116               surface_output,                                                 &
117               syn_turb_gen,                                                   &
118               urban_surface,                                                  &
119               virtual_flight,                                                 &
120               virtual_measurement,                                            &
121               wind_turbine
122
123!
124!-- load interface routines of all PALM modules
125    USE biometeorology_mod,                                                    &
126        ONLY:  bio_parin,                                                      &
127               bio_check_data_output,                                          &
128               bio_init,                                                       &
129               bio_init_checks,                                                &
130               bio_header,                                                     &
131               bio_3d_data_averaging,                                          &
132               bio_data_output_2d,                                             &
133               bio_data_output_3d,                                             &
134               bio_rrd_global,                                                 &
135               bio_rrd_local,                                                  &
136               bio_wrd_global,                                                 &
137               bio_wrd_local
138
139    USE bulk_cloud_model_mod,                                                  &
140        ONLY:  bulk_cloud_model,                                               &
141               bcm_parin,                                                      &
142               bcm_check_parameters,                                           &
143               bcm_check_data_output_pr,                                       &
144               bcm_check_data_output,                                          &
145               bcm_init_arrays,                                                &
146               bcm_init,                                                       &
147               bcm_header,                                                     &
148               bcm_swap_timelevel,                                             &
149               bcm_3d_data_averaging,                                          &
150               bcm_data_output_2d,                                             &
151               bcm_data_output_3d,                                             &
152               bcm_rrd_global,                                                 &
153               bcm_wrd_global,                                                 &
154               bcm_rrd_local,                                                  &
155               bcm_wrd_local
156
157   USE chemistry_model_mod,                                                    &
158       ONLY:  chem_parin,                                                      &
159              chem_check_parameters,                                           &
160              chem_check_data_output_pr,                                       &
161              chem_check_data_output,                                          &
162              chem_init_arrays,                                                &
163              chem_init,                                                       &
164              chem_header,                                                     &
165              chem_swap_timelevel,                                             &
166              chem_3d_data_averaging,                                          &
167              chem_data_output_2d,                                             &
168              chem_data_output_3d,                                             &
169              chem_statistics,                                                 &
170              chem_rrd_local,                                                  &
171               chem_wrd_local
172
173    USE flight_mod,                                                            &
174        ONLY:  flight_parin,                                                   &
175               flight_header,                                                  &
176               flight_init,                                                    &
177               flight_rrd_global,                                              &
178               flight_wrd_global
179
180    USE gust_mod,                                                              &
181        ONLY:  gust_module_enabled,                                            &
182               gust_parin,                                                     &
183               gust_check_parameters,                                          &
184               gust_check_data_output_pr,                                      &
185               gust_check_data_output,                                         &
186               gust_init_arrays,                                               &
187               gust_init,                                                      &
188               gust_header,                                                    &
189               gust_actions,                                                   &
190               gust_prognostic_equations,                                      &
191               gust_swap_timelevel,                                            &
192               gust_3d_data_averaging,                                         &
193               gust_data_output_2d,                                            &
194               gust_data_output_3d,                                            &
195               gust_statistics,                                                &
196               gust_rrd_global,                                                &
197               gust_wrd_global,                                                &
198               gust_rrd_local,                                                 &
199               gust_wrd_local
200
201    USE indoor_model_mod,                                                      &
202        ONLY:  im_parin,                                                       &
203               im_check_data_output,                                           &
204               im_check_parameters,                                            &
205               im_data_output_3d,                                              &
206               im_init
207
208    USE land_surface_model_mod,                                                &
209        ONLY:  lsm_parin,                                                      &
210               lsm_check_parameters,                                           &
211               lsm_check_data_output_pr,                                       &
212               lsm_check_data_output,                                          &
213               lsm_init_arrays,                                                &
214               lsm_init,                                                       &
215               lsm_header,                                                     &
216               lsm_swap_timelevel,                                             &
217               lsm_3d_data_averaging,                                          &
218               lsm_data_output_2d,                                             &
219               lsm_rrd_local,                                                  &
220               lsm_wrd_local
221
222    USE lsf_nudging_mod,                                                       &
223        ONLY:  lsf_nudging_check_parameters,                                   &
224               lsf_nudging_check_data_output_pr,                               &
225               lsf_init,                                                       &
226               nudge_init,                                                     &
227               lsf_nudging_header
228
229    USE multi_agent_system_mod,                                                &
230        ONLY:  mas_parin
231
232    USE nesting_offl_mod,                                                      &
233        ONLY:  nesting_offl_parin,                                             &
234               nesting_offl_check_parameters,                                  &
235               nesting_offl_header
236
237    USE ocean_mod,                                                             &
238        ONLY:  ocean_parin,                                                    &
239               ocean_check_parameters,                                         &
240               ocean_check_data_output_pr,                                     &
241               ocean_check_data_output,                                        &
242               ocean_init_arrays,                                              &
243               ocean_init,                                                     &
244               ocean_header,                                                   &
245               ocean_prognostic_equations,                                     &
246               ocean_swap_timelevel,                                           &
247               ocean_3d_data_averaging,                                        &
248               ocean_data_output_2d,                                           &
249               ocean_data_output_3d,                                           &
250               ocean_rrd_global,                                               &
251               ocean_wrd_global,                                               &
252               ocean_rrd_local,                                                &
253               ocean_wrd_local
254
255    USE plant_canopy_model_mod,                                                &
256         ONLY: pcm_parin,                                                      &
257               pcm_check_parameters,                                           &
258               pcm_check_data_output,                                          &
259               pcm_init,                                                       &
260               pcm_header,                                                     &
261               pcm_data_output_3d
262
263    USE radiation_model_mod,                                                   &
264        ONLY:  radiation,                                                      &
265               radiation_parin,                                                &
266               radiation_check_parameters,                                     &
267               radiation_check_data_output_ts,                                 &
268               radiation_check_data_output_pr,                                 &
269               radiation_check_data_output,                                    &
270               radiation_init,                                                 &
271               radiation_header,                                               &
272               radiation_3d_data_averaging,                                    &
273               radiation_data_output_2d,                                       &
274               radiation_data_output_3d,                                       &
275               radiation_rrd_local,                                            &
276               radiation_wrd_local
277
278    USE salsa_mod,                                                             &
279        ONLY:  salsa_parin,                                                    &
280               salsa_check_parameters,                                         &
281               salsa_check_data_output,                                        &
282               salsa_init_arrays,                                              &
283               salsa_init,                                                     &
284               salsa_header,                                                   &
285               salsa_prognostic_equations,                                     &
286               salsa_swap_timelevel,                                           &
287               salsa_3d_data_averaging,                                        &
288               salsa_data_output_2d,                                           &
289               salsa_data_output_3d,                                           &
290               salsa_rrd_local,                                                &
291               salsa_wrd_local
292
293    USE spectra_mod,                                                           &
294        ONLY:  calculate_spectra,                                              &
295               spectra_parin,                                                  &
296               spectra_check_parameters,                                       &
297               spectra_header
298
299    USE surface_data_output_mod,                                               &
300        ONLY:  surface_data_output_parin,                                      &
301               surface_data_output_check_parameters,                           &
302               surface_data_output_init_arrays,                                &
303               surface_data_output_rrd_local,                                  &
304               surface_data_output_rrd_global,                                 &
305               surface_data_output_wrd_local,                                  &
306               surface_data_output_wrd_global
307
308    USE synthetic_turbulence_generator_mod,                                    &
309        ONLY:  stg_parin,                                                      &
310               stg_check_parameters,                                           &
311               stg_header,                                                     &
312               stg_rrd_global,                                                 &
313               stg_wrd_global
314
315    USE urban_surface_mod,                                                     &
316        ONLY:  usm_parin,                                                      &
317               usm_check_parameters,                                           &
318               usm_check_data_output,                                          &
319               usm_init_arrays,                                                &
320               usm_init,                                                       &
321               usm_swap_timelevel,                                             &
322               usm_3d_data_averaging,                                          &
323               usm_rrd_local,                                                  &
324               usm_wrd_local
325
326    USE user,                                                                  &
327        ONLY:  user_module_enabled,                                            &
328               user_parin,                                                     &
329               user_check_parameters,                                          &
330               user_check_data_output_ts,                                      &
331               user_check_data_output_pr,                                      &
332               user_check_data_output,                                         &
333               user_init,                                                      &
334               user_init_arrays,                                               &
335               user_header,                                                    &
336               user_actions,                                                   &
337               user_3d_data_averaging,                                         &
338               user_data_output_2d,                                            &
339               user_data_output_3d,                                            &
340               user_statistics,                                                &
341               user_rrd_global,                                                &
342               user_rrd_local,                                                 &
343               user_wrd_global,                                                &
344               user_wrd_local,                                                 &
345               user_last_actions
346
347    USE virtual_measurement_mod,                                               &
348        ONLY:  vm_check_parameters,                                            &
349               vm_init,                                                        &
350               vm_last_actions,                                                &
351               vm_parin
352
353    USE wind_turbine_model_mod,                                                &
354        ONLY:  wtm_parin,                                                      &
355               wtm_check_parameters,                                           &
356               wtm_init_arrays,                                                &
357               wtm_init,                                                       &
358               wtm_rrd_global,                                                 &
359               wtm_wrd_global
360
361    IMPLICIT NONE
362
363    PRIVATE
364
365!
366!-- Public functions
367    PUBLIC                                                                     &
368       module_interface_parin,                                                 &
369       module_interface_check_parameters,                                      &
370       module_interface_check_data_output_ts,                                  &
371       module_interface_check_data_output_pr,                                  &
372       module_interface_check_data_output,                                     &
373       module_interface_init_masks,                                            &
374       module_interface_define_netcdf_grid,                                    &
375       module_interface_init_arrays,                                           &
376       module_interface_init,                                                  &
377       module_interface_init_checks,                                           &
378       module_interface_header,                                                &
379       module_interface_actions,                                               &
380       module_interface_prognostic_equations,                                  &
381       module_interface_swap_timelevel,                                        &
382       module_interface_3d_data_averaging,                                     &
383       module_interface_data_output_2d,                                        &
384       module_interface_data_output_3d,                                        &
385       module_interface_statistics,                                            &
386       module_interface_rrd_global,                                            &
387       module_interface_wrd_global,                                            &
388       module_interface_rrd_local,                                             &
389       module_interface_wrd_local,                                             &
390       module_interface_last_actions
391
392
393    INTERFACE module_interface_parin
394       MODULE PROCEDURE module_interface_parin
395    END INTERFACE module_interface_parin
396
397    INTERFACE module_interface_check_parameters
398       MODULE PROCEDURE module_interface_check_parameters
399    END INTERFACE module_interface_check_parameters
400
401    INTERFACE module_interface_check_data_output_ts
402       MODULE PROCEDURE module_interface_check_data_output_ts
403    END INTERFACE module_interface_check_data_output_ts
404
405    INTERFACE module_interface_check_data_output_pr
406       MODULE PROCEDURE module_interface_check_data_output_pr
407    END INTERFACE module_interface_check_data_output_pr
408
409    INTERFACE module_interface_check_data_output
410       MODULE PROCEDURE module_interface_check_data_output
411    END INTERFACE module_interface_check_data_output
412
413    INTERFACE module_interface_init_masks
414       MODULE PROCEDURE module_interface_init_masks
415    END INTERFACE module_interface_init_masks
416
417    INTERFACE module_interface_define_netcdf_grid
418       MODULE PROCEDURE module_interface_define_netcdf_grid
419    END INTERFACE module_interface_define_netcdf_grid
420
421    INTERFACE module_interface_init_arrays
422       MODULE PROCEDURE module_interface_init_arrays
423    END INTERFACE module_interface_init_arrays
424
425    INTERFACE module_interface_init
426       MODULE PROCEDURE module_interface_init
427    END INTERFACE module_interface_init
428
429    INTERFACE module_interface_init_checks
430       MODULE PROCEDURE module_interface_init_checks
431    END INTERFACE module_interface_init_checks
432
433    INTERFACE module_interface_header
434       MODULE PROCEDURE module_interface_header
435    END INTERFACE module_interface_header
436
437    INTERFACE module_interface_actions
438       MODULE PROCEDURE module_interface_actions
439       MODULE PROCEDURE module_interface_actions_ij
440    END INTERFACE module_interface_actions
441
442    INTERFACE module_interface_prognostic_equations
443       MODULE PROCEDURE module_interface_prognostic_equations
444       MODULE PROCEDURE module_interface_prognostic_equations_ij
445    END INTERFACE module_interface_prognostic_equations
446
447    INTERFACE module_interface_swap_timelevel
448       MODULE PROCEDURE module_interface_swap_timelevel
449    END INTERFACE module_interface_swap_timelevel
450
451    INTERFACE module_interface_3d_data_averaging
452       MODULE PROCEDURE module_interface_3d_data_averaging
453    END INTERFACE module_interface_3d_data_averaging
454
455    INTERFACE module_interface_data_output_2d
456       MODULE PROCEDURE module_interface_data_output_2d
457    END INTERFACE module_interface_data_output_2d
458
459    INTERFACE module_interface_data_output_3d
460       MODULE PROCEDURE module_interface_data_output_3d
461    END INTERFACE module_interface_data_output_3d
462
463    INTERFACE module_interface_statistics
464       MODULE PROCEDURE module_interface_statistics
465    END INTERFACE module_interface_statistics
466
467    INTERFACE module_interface_rrd_global
468       MODULE PROCEDURE module_interface_rrd_global
469    END INTERFACE module_interface_rrd_global
470
471    INTERFACE module_interface_wrd_global
472       MODULE PROCEDURE module_interface_wrd_global
473    END INTERFACE module_interface_wrd_global
474
475    INTERFACE module_interface_rrd_local
476       MODULE PROCEDURE module_interface_rrd_local
477    END INTERFACE module_interface_rrd_local
478
479    INTERFACE module_interface_wrd_local
480       MODULE PROCEDURE module_interface_wrd_local
481    END INTERFACE module_interface_wrd_local
482
483    INTERFACE module_interface_last_actions
484       MODULE PROCEDURE module_interface_last_actions
485    END INTERFACE module_interface_last_actions
486
487
488 CONTAINS
489
490
491!------------------------------------------------------------------------------!
492! Description:
493! ------------
494!> Read module-specific parameter namelists
495!------------------------------------------------------------------------------!
496 SUBROUTINE module_interface_parin
497
498
499    CALL bio_parin
500    CALL bcm_parin
501    CALL chem_parin
502    CALL flight_parin ! ToDo: rename module to match filename
503    CALL gust_parin
504    CALL im_parin
505    CALL lsm_parin
506    ! ToDo: create parin routine for large_scale_forcing and nudging (should be seperate modules or new module switch)
507    CALL mas_parin
508    CALL nesting_offl_parin
509    CALL ocean_parin
510    CALL pcm_parin
511    CALL radiation_parin
512    CALL salsa_parin
513    CALL spectra_parin
514    CALL surface_data_output_parin
515    CALL stg_parin
516    CALL user_parin ! ToDo: make user code a single Fortran module
517    CALL usm_parin
518    CALL vm_parin
519    CALL wtm_parin
520
521    CALL package_parin ! ToDo: deprecated, needs to be dissolved
522
523
524 END SUBROUTINE module_interface_parin
525
526
527!------------------------------------------------------------------------------!
528! Description:
529! ------------
530!> Perform module-specific initialization checks
531!------------------------------------------------------------------------------!
532 SUBROUTINE module_interface_check_parameters
533
534
535    IF ( bulk_cloud_model )     CALL bcm_check_parameters
536    IF ( air_chemistry )        CALL chem_check_parameters
537    IF ( gust_module_enabled )  CALL gust_check_parameters
538    IF ( indoor_model )         CALL im_check_parameters
539    IF ( land_surface )         CALL lsm_check_parameters
540    IF ( large_scale_forcing  .OR.  nudging )  CALL lsf_nudging_check_parameters ! ToDo: create single module switch
541    IF ( nesting_offline )      CALL nesting_offl_check_parameters
542    IF ( ocean_mode )           CALL ocean_check_parameters
543    IF ( plant_canopy )         CALL pcm_check_parameters
544    IF ( radiation )            CALL radiation_check_parameters
545    IF ( salsa )                CALL salsa_check_parameters
546    IF ( calculate_spectra )    CALL spectra_check_parameters
547    IF ( surface_output )       CALL surface_data_output_check_parameters
548    IF ( syn_turb_gen )         CALL stg_check_parameters
549    IF ( urban_surface )        CALL usm_check_parameters
550    IF ( virtual_measurement )  CALL vm_check_parameters
551    IF ( wind_turbine )         CALL wtm_check_parameters
552    IF ( user_module_enabled )  CALL user_check_parameters
553
554
555 END SUBROUTINE module_interface_check_parameters
556
557
558!------------------------------------------------------------------------------!
559! Description:
560! ------------
561!> Check module-specific data output of timeseries
562!------------------------------------------------------------------------------!
563 SUBROUTINE module_interface_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
564
565
566    INTEGER(iwp),      INTENT(IN)    ::  dots_max !< variable output array index
567    INTEGER(iwp),      INTENT(INOUT)    ::  dots_num !< variable output array index
568    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label
569    CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit
570
571
572    IF ( radiation )  THEN
573       CALL radiation_check_data_output_ts( dots_max, dots_num )
574    ENDIF
575
576    IF ( user_module_enabled )  THEN
577       CALL user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit )
578    ENDIF
579
580
581 END SUBROUTINE module_interface_check_data_output_ts
582
583
584!------------------------------------------------------------------------------!
585! Description:
586! ------------
587!> Check module-specific data output of profiles
588!------------------------------------------------------------------------------!
589 SUBROUTINE module_interface_check_data_output_pr( variable, var_count, unit,  &
590                                                   dopr_unit )
591
592
593    CHARACTER (LEN=*), INTENT(IN)    ::  variable  !< variable name
594    INTEGER(iwp),      INTENT(IN)    ::  var_count !< variable output array index
595    CHARACTER (LEN=*), INTENT(INOUT) ::  unit      !< physical unit of variable
596    CHARACTER (LEN=*), INTENT(OUT)   ::  dopr_unit !< local value of dopr_unit
597
598    IF ( unit == 'illegal' .AND.  bulk_cloud_model )  THEN
599       CALL bcm_check_data_output_pr( variable, var_count, unit, dopr_unit )
600    ENDIF
601
602    IF ( unit == 'illegal' .AND.  air_chemistry )  THEN
603       CALL chem_check_data_output_pr( variable, var_count, unit, dopr_unit )
604    ENDIF
605
606    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
607       CALL gust_check_data_output_pr( variable, var_count, unit, dopr_unit )
608    ENDIF
609
610    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
611       CALL lsm_check_data_output_pr( variable, var_count, unit, dopr_unit )
612    ENDIF
613
614    IF ( unit == 'illegal' )  THEN ! ToDo: add module switch if possible
615       CALL lsf_nudging_check_data_output_pr( variable, var_count, unit, dopr_unit )
616    ENDIF
617
618    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
619       CALL ocean_check_data_output_pr( variable, var_count, unit, dopr_unit )
620    ENDIF
621
622    IF ( unit == 'illegal'  .AND.  radiation )  THEN
623       CALL radiation_check_data_output_pr( variable, var_count, unit, dopr_unit )
624    ENDIF
625
626    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
627       unit = '' ! ToDo: Seems like a hack. Find a general soultion!
628       CALL user_check_data_output_pr( variable, var_count, unit, dopr_unit )
629    ENDIF
630
631
632 END SUBROUTINE module_interface_check_data_output_pr
633
634!------------------------------------------------------------------------------!
635! Description:
636! ------------
637!> Check module-specific 2D and 3D data output
638!------------------------------------------------------------------------------!
639 SUBROUTINE module_interface_check_data_output( variable, unit, i, j, ilen, k )
640
641
642    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
643    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
644
645    INTEGER(iwp),      INTENT(IN)    :: i         !< ToDo: remove dummy argument, instead pass string from data_output
646    INTEGER(iwp),      INTENT(IN)    :: j         !< average quantity? 0 = no, 1 = yes
647    INTEGER(iwp),      INTENT(IN)    :: ilen      !< ToDo: remove dummy argument, instead pass string from data_output
648    INTEGER(iwp),      INTENT(IN)    :: k         !< ToDo: remove dummy argument, instead pass string from data_output
649
650    IF ( unit == 'illegal'  .AND.  biometeorology )  THEN
651       CALL bio_check_data_output( variable, unit, i, j, ilen, k )
652    ENDIF
653
654    IF ( unit == 'illegal'  .AND.  bulk_cloud_model  )  THEN
655       CALL bcm_check_data_output( variable, unit )
656    ENDIF
657
658    IF ( unit == 'illegal'  .AND.  air_chemistry                               &
659         .AND.  (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
660       CALL chem_check_data_output( variable, unit, i, ilen, k )
661    ENDIF
662
663    IF ( unit == 'illegal'  .AND.  gust_module_enabled  )  THEN
664       CALL gust_check_data_output( variable, unit )
665    ENDIF
666
667    IF ( unit == 'illegal' )  THEN  ! ToDo: add module switch if possible
668       CALL lsm_check_data_output( variable, unit, i, ilen, k )
669    ENDIF
670
671    IF ( unit == 'illegal'  .AND.  ocean_mode )  THEN
672       CALL ocean_check_data_output( variable, unit )
673    ENDIF
674
675    IF ( unit == 'illegal'  .AND.  plant_canopy                                &
676         .AND.  variable(1:4) == 'pcm_' )  THEN  ! ToDo: remove aditional conditions
677       CALL pcm_check_data_output( variable, unit )
678    ENDIF
679
680    IF ( unit == 'illegal'  .AND.  radiation )  THEN
681       CALL radiation_check_data_output( variable, unit, i, ilen, k )
682    ENDIF
683
684    IF ( unit == 'illegal' .AND. salsa ) THEN
685       CALL salsa_check_data_output( variable, unit )
686    ENDIF
687
688    IF ( unit == 'illegal' .AND. indoor_model ) THEN
689       CALL im_check_data_output( variable, unit )
690    ENDIF
691   
692    IF ( unit == 'illegal'  .AND.  urban_surface                      &
693        .AND.  variable(1:4) == 'usm_' )  THEN  ! ToDo: remove aditional conditions
694       CALL usm_check_data_output( variable, unit )
695    ENDIF
696
697    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
698       unit = ''
699       CALL user_check_data_output( variable, unit )
700    ENDIF
701
702
703 END SUBROUTINE module_interface_check_data_output
704
705
706!------------------------------------------------------------------------------!
707!
708! Description:
709! ------------
710!> Interface for init_masks. ToDo: get rid of these redundant calls!
711!------------------------------------------------------------------------------!
712 SUBROUTINE module_interface_init_masks( variable, unit )
713
714
715    CHARACTER (LEN=*), INTENT(IN)    ::  variable !< variable name
716    CHARACTER (LEN=*), INTENT(INOUT) ::  unit     !< physical unit of variable
717
718    IF ( unit == 'illegal'  .AND.  air_chemistry                               &
719         .AND.  (variable(1:3) == 'kc_' .OR. variable(1:3) == 'em_') )  THEN  ! ToDo: remove aditional conditions
720       CALL chem_check_data_output( variable, unit, 0, 0, 0 )
721    ENDIF
722
723    IF ( unit == 'illegal'  .AND.  radiation )  THEN
724       CALL radiation_check_data_output( variable, unit, 0, 0, 0 )
725    ENDIF
726
727    IF ( unit == 'illegal'  .AND.  salsa )  THEN
728       CALL salsa_check_data_output( variable, unit )
729    ENDIF
730
731    IF ( unit == 'illegal'  .AND.  user_module_enabled )  THEN
732       unit = ''
733       CALL user_check_data_output( variable, unit )
734    ENDIF
735
736
737 END SUBROUTINE module_interface_init_masks
738
739
740!------------------------------------------------------------------------------!
741!
742! Description:
743! ------------
744!> Define appropriate grid for module-specific netcdf output variables.
745!------------------------------------------------------------------------------!
746 SUBROUTINE module_interface_define_netcdf_grid( var, found,                   &
747                                                 grid_x, grid_y, grid_z )
748
749
750    CHARACTER (LEN=*), INTENT(IN)  ::  var    !< variable name
751    LOGICAL,           INTENT(OUT) ::  found  !< indicates if variable was found
752    CHARACTER (LEN=*), INTENT(OUT) ::  grid_x !< netcdf dimension in x-direction
753    CHARACTER (LEN=*), INTENT(OUT) ::  grid_y !< netcdf dimension in y-direction
754    CHARACTER (LEN=*), INTENT(OUT) ::  grid_z !< netcdf dimension in z-direction
755!
756!-- As long as no action is done in this subroutine, initialize strings with
757!-- intent(out) attribute, in order to avoid compiler warnings.
758    found  = .FALSE.
759    grid_x = 'none'
760    grid_y = 'none'
761    grid_z = 'none'
762!
763!-- Use var to avoid compiler warning about unused variable
764    IF ( var == ' ' )  RETURN
765
766 END SUBROUTINE module_interface_define_netcdf_grid
767
768
769!------------------------------------------------------------------------------!
770! Description:
771! ------------
772!> Allocate module-specific arrays and pointers
773!------------------------------------------------------------------------------!
774 SUBROUTINE module_interface_init_arrays
775
776
777    IF ( bulk_cloud_model    )  CALL bcm_init_arrays
778    IF ( air_chemistry       )  CALL chem_init_arrays
779    IF ( gust_module_enabled )  CALL gust_init_arrays
780    IF ( land_surface        )  CALL lsm_init_arrays
781    IF ( ocean_mode          )  CALL ocean_init_arrays
782    IF ( salsa               )  CALL salsa_init_arrays
783    IF ( urban_surface       )  CALL usm_init_arrays
784    IF ( surface_output      )  CALL surface_data_output_init_arrays
785    IF ( wind_turbine        )  CALL wtm_init_arrays
786    IF ( user_module_enabled )  CALL user_init_arrays
787
788
789 END SUBROUTINE module_interface_init_arrays
790
791
792!------------------------------------------------------------------------------!
793! Description:
794! ------------
795!> Perform module-specific initialization
796!------------------------------------------------------------------------------!
797 SUBROUTINE module_interface_init
798
799
800    IF ( biometeorology      )  CALL bio_init
801    IF ( bulk_cloud_model    )  CALL bcm_init
802    IF ( air_chemistry       )  CALL chem_init
803    IF ( virtual_flight      )  CALL flight_init
804    IF ( gust_module_enabled )  CALL gust_init
805    IF ( indoor_model        )  CALL im_init
806    IF ( large_scale_forcing )  CALL lsf_init
807    IF ( land_surface        )  CALL lsm_init
808    IF ( nudging             )  CALL nudge_init
809    IF ( ocean_mode          )  CALL ocean_init
810    IF ( plant_canopy        )  CALL pcm_init
811    IF ( salsa               )  CALL salsa_init
812    IF ( urban_surface       )  CALL usm_init
813    IF ( virtual_measurement )  CALL vm_init
814    IF ( wind_turbine        )  CALL wtm_init
815    IF ( radiation           )  CALL radiation_init
816    IF ( user_module_enabled )  CALL user_init
817
818
819 END SUBROUTINE module_interface_init
820
821
822!------------------------------------------------------------------------------!
823! Description:
824! ------------
825!> Perform module-specific post-initialization checks
826!------------------------------------------------------------------------------!
827 SUBROUTINE module_interface_init_checks
828
829
830    IF ( biometeorology      )  CALL bio_init_checks
831
832
833 END SUBROUTINE module_interface_init_checks
834
835
836!------------------------------------------------------------------------------!
837! Description:
838! ------------
839!> Gather module-specific header output
840!------------------------------------------------------------------------------!
841 SUBROUTINE module_interface_header( io )
842
843
844    INTEGER(iwp), INTENT(IN) ::  io  !< unit of the output file
845
846
847    IF ( biometeorology      )  CALL bio_header ( io )
848    IF ( bulk_cloud_model    )  CALL bcm_header( io )
849    IF ( air_chemistry       )  CALL chem_header ( io )
850    IF ( virtual_flight      )  CALL flight_header( io )
851    IF ( gust_module_enabled )  CALL gust_header( io )
852    IF ( land_surface        )  CALL lsm_header( io )
853    IF ( large_scale_forcing )  CALL lsf_nudging_header( io )
854    IF ( nesting_offline     )  CALL nesting_offl_header( io )
855    IF ( ocean_mode          )  CALL ocean_header( io )
856    IF ( plant_canopy        )  CALL pcm_header( io )
857    IF ( radiation           )  CALL radiation_header( io )
858    IF ( salsa               )  CALL salsa_header( io )
859    IF ( calculate_spectra   )  CALL spectra_header( io )
860    IF ( syn_turb_gen        )  CALL stg_header( io )
861    IF ( user_module_enabled )  CALL user_header( io )
862
863
864 END SUBROUTINE module_interface_header
865
866
867!------------------------------------------------------------------------------!
868! Description:
869! ------------
870!> Perform module-specific actions while in time-integration (cache-optimized)
871!------------------------------------------------------------------------------!
872 SUBROUTINE module_interface_actions( location )
873
874
875    CHARACTER (LEN=*), INTENT(IN) ::  location !< call location string
876
877
878    IF ( gust_module_enabled )  CALL gust_actions( location )
879    IF ( user_module_enabled )  CALL user_actions( location )
880
881
882 END SUBROUTINE module_interface_actions
883
884
885!------------------------------------------------------------------------------!
886! Description:
887! ------------
888!> Perform module-specific actions while in time-integration (vector-optimized)
889!------------------------------------------------------------------------------!
890 SUBROUTINE module_interface_actions_ij( i, j, location )
891
892
893    INTEGER(iwp),      INTENT(IN) ::  i         !< grid index in x-direction
894    INTEGER(iwp),      INTENT(IN) ::  j         !< grid index in y-direction
895    CHARACTER (LEN=*), INTENT(IN) ::  location  !< call location string
896
897
898    IF ( gust_module_enabled )  CALL gust_actions( i, j, location )
899    IF ( user_module_enabled )  CALL user_actions( i, j, location )
900
901
902 END SUBROUTINE module_interface_actions_ij
903
904
905!------------------------------------------------------------------------------!
906! Description:
907! ------------
908!> Compute module-specific prognostic_equations (cache-optimized)
909!------------------------------------------------------------------------------!
910 SUBROUTINE module_interface_prognostic_equations()
911
912
913    IF ( gust_module_enabled )  CALL gust_prognostic_equations()
914    IF ( ocean_mode          )  CALL ocean_prognostic_equations()
915    IF ( salsa               )  CALL salsa_prognostic_equations()
916
917
918 END SUBROUTINE module_interface_prognostic_equations
919
920
921!------------------------------------------------------------------------------!
922! Description:
923! ------------
924!> Compute module-specific prognostic_equations (vector-optimized)
925!------------------------------------------------------------------------------!
926 SUBROUTINE module_interface_prognostic_equations_ij( i, j, i_omp_start, tn )
927
928
929    INTEGER(iwp), INTENT(IN) ::  i            !< grid index in x-direction
930    INTEGER(iwp), INTENT(IN) ::  j            !< grid index in y-direction
931    INTEGER(iwp), INTENT(IN) ::  i_omp_start  !< first loop index of i-loop in prognostic_equations
932    INTEGER(iwp), INTENT(IN) ::  tn           !< task number of openmp task
933
934
935    IF ( gust_module_enabled )  CALL gust_prognostic_equations( i, j, i_omp_start, tn )
936    IF ( ocean_mode          )  CALL ocean_prognostic_equations( i, j, i_omp_start, tn )
937    IF ( salsa               )  CALL salsa_prognostic_equations( i, j, i_omp_start, tn )
938
939
940 END SUBROUTINE module_interface_prognostic_equations_ij
941
942
943!------------------------------------------------------------------------------!
944! Description:
945! ------------
946!> Swap the timelevel pointers for module-specific arrays
947!------------------------------------------------------------------------------!
948 SUBROUTINE module_interface_swap_timelevel ( swap_mode )
949
950
951    INTEGER(iwp), INTENT(IN) :: swap_mode !< determines procedure of pointer swap
952
953    IF ( bulk_cloud_model    )  CALL bcm_swap_timelevel( swap_mode )
954    IF ( air_chemistry       )  CALL chem_swap_timelevel( swap_mode )
955    IF ( gust_module_enabled )  CALL gust_swap_timelevel( swap_mode )
956    IF ( land_surface        )  CALL lsm_swap_timelevel( swap_mode )
957    IF ( ocean_mode          )  CALL ocean_swap_timelevel( swap_mode )
958    IF ( salsa               )  CALL salsa_swap_timelevel( swap_mode )
959    IF ( urban_surface       )  CALL usm_swap_timelevel( swap_mode )
960
961
962 END SUBROUTINE module_interface_swap_timelevel
963
964
965!------------------------------------------------------------------------------!
966!
967! Description:
968! ------------
969!> Perform module-specific averaging of 3D data
970!------------------------------------------------------------------------------!
971 SUBROUTINE module_interface_3d_data_averaging( mode, variable )
972
973
974    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< averaging interface mode
975    CHARACTER (LEN=*), INTENT(IN) ::  variable !< variable name
976
977    IF ( biometeorology      )  CALL bio_3d_data_averaging( mode, variable )
978    IF ( bulk_cloud_model    )  CALL bcm_3d_data_averaging( mode, variable )
979    IF ( air_chemistry       )  CALL chem_3d_data_averaging( mode, variable )
980    IF ( gust_module_enabled )  CALL gust_3d_data_averaging( mode, variable )
981    IF ( land_surface        )  CALL lsm_3d_data_averaging( mode, variable )
982    IF ( ocean_mode          )  CALL ocean_3d_data_averaging( mode, variable )
983    IF ( radiation           )  CALL radiation_3d_data_averaging( mode, variable )
984    IF ( salsa               )  CALL salsa_3d_data_averaging( mode, variable )
985    IF ( urban_surface       )  CALL usm_3d_data_averaging( mode, variable )
986    IF ( user_module_enabled )  CALL user_3d_data_averaging( mode, variable )
987
988
989 END SUBROUTINE module_interface_3d_data_averaging
990
991!------------------------------------------------------------------------------!
992!
993! Description:
994! ------------
995!> Define module-specific 2D output variables
996!------------------------------------------------------------------------------!
997 SUBROUTINE module_interface_data_output_2d( av, variable, found, grid, mode,  &
998                                             local_pf, two_d, nzb_do, nzt_do,  &
999                                             fill_value )
1000
1001    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
1002    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
1003    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
1004    CHARACTER (LEN=*), INTENT(INOUT) ::  grid       !< name of vertical grid
1005    CHARACTER (LEN=*), INTENT(IN)    ::  mode       !< either 'xy', 'xz' or 'yz'
1006    LOGICAL,           INTENT(OUT)   ::  two_d      !< flag for 2D variables
1007    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
1008    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
1009    REAL(wp),          INTENT(IN)    ::  fill_value !< to be removed
1010
1011    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(OUT) ::  local_pf !< ToDo: can also be kind=sp
1012
1013
1014    IF ( .NOT. found  .AND.  biometeorology )  THEN
1015       CALL bio_data_output_2d(                                                &
1016               av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do      &
1017            )
1018    ENDIF
1019
1020    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
1021       CALL bcm_data_output_2d(                                                &
1022               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1023            )
1024    ENDIF
1025
1026    IF ( .NOT. found  .AND.  air_chemistry )  THEN
1027       CALL chem_data_output_2d(                                               &
1028               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, fill_value &
1029            )
1030    ENDIF
1031
1032    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1033       CALL gust_data_output_2d(                                               &
1034               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do, fill_value &
1035            )
1036    ENDIF
1037
1038    IF ( .NOT. found  .AND.  land_surface )  THEN
1039       CALL lsm_data_output_2d(                                                &
1040               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1041            )
1042    ENDIF
1043
1044    IF ( .NOT. found  .AND.  ocean_mode )  THEN
1045       CALL ocean_data_output_2d(                                              &
1046               av, variable, found, grid, mode, local_pf, nzb_do, nzt_do       &
1047            )
1048    ENDIF
1049
1050    IF ( .NOT. found  .AND.  radiation )  THEN
1051       CALL radiation_data_output_2d(                                          &
1052               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1053            )
1054    ENDIF
1055
1056    IF ( .NOT. found  .AND.  salsa )  THEN
1057       CALL salsa_data_output_2d(                                              &
1058               av, variable, found, grid, mode, local_pf, two_d, nzb_do, nzt_do&
1059            )
1060    ENDIF
1061
1062    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1063       CALL user_data_output_2d(                                               &
1064               av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do      &
1065            )
1066    ENDIF
1067
1068 END SUBROUTINE module_interface_data_output_2d
1069
1070
1071!------------------------------------------------------------------------------!
1072!
1073! Description:
1074! ------------
1075!> Define module-specific 3D output variables
1076!------------------------------------------------------------------------------!
1077 SUBROUTINE module_interface_data_output_3d( av, variable, found, local_pf,    &
1078                                             fill_value, resorted, nzb_do, nzt_do )
1079
1080
1081    INTEGER(iwp),      INTENT(IN)    ::  av         !< flag for (non-)average output
1082    CHARACTER (LEN=*), INTENT(IN)    ::  variable   !< variable name
1083    LOGICAL,           INTENT(INOUT) ::  found      !< flag if output variable is found
1084    REAL(wp),          INTENT(IN)    ::  fill_value !< ToDo: refactor
1085    LOGICAL,           INTENT(OUT)   ::  resorted   !< flag if output has been resorted
1086    INTEGER(iwp),      INTENT(IN)    ::  nzb_do     !< vertical output index (bottom) (usually 0)
1087    INTEGER(iwp),      INTENT(IN)    ::  nzt_do     !< vertical output index (top) (usually nz_do3d)
1088
1089    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do), INTENT(OUT) ::  local_pf
1090
1091
1092    IF ( .NOT. found  .AND.  biometeorology )  THEN
1093       CALL bio_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1094       resorted = .FALSE.
1095    ENDIF
1096
1097    IF ( .NOT. found  .AND.  bulk_cloud_model )  THEN
1098       CALL bcm_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1099       resorted = .TRUE.
1100    ENDIF
1101
1102    IF ( .NOT. found  .AND.  air_chemistry )  THEN
1103       CALL chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1104       resorted = .TRUE.
1105    ENDIF
1106
1107    IF ( .NOT. found  .AND.  gust_module_enabled )  THEN
1108       CALL gust_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1109       resorted = .TRUE.
1110    ENDIF
1111   
1112    IF ( .NOT. found  .AND.  indoor_model )  THEN
1113       CALL im_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1114       resorted = .TRUE.
1115    ENDIF
1116
1117    IF ( .NOT. found  .AND.  ocean_mode )  THEN
1118       CALL ocean_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1119       resorted = .TRUE.
1120    ENDIF
1121
1122    IF ( .NOT. found  .AND.  plant_canopy )  THEN
1123       CALL pcm_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do )
1124       resorted = .TRUE.
1125    ENDIF
1126
1127    IF ( .NOT. found  .AND.  radiation )  THEN
1128       CALL radiation_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1129       resorted = .TRUE.
1130    ENDIF
1131
1132    IF ( .NOT. found  .AND.  salsa )  THEN
1133       CALL salsa_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1134       resorted = .TRUE.
1135    ENDIF
1136
1137    IF ( .NOT. found  .AND.  user_module_enabled )  THEN
1138       CALL user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do )
1139       resorted = .TRUE.
1140    ENDIF
1141
1142
1143 END SUBROUTINE module_interface_data_output_3d
1144
1145
1146!------------------------------------------------------------------------------!
1147! Description:
1148! ------------
1149!> Compute module-specific profile and timeseries data
1150!------------------------------------------------------------------------------!
1151 SUBROUTINE module_interface_statistics( mode, sr, tn, dots_max )
1152
1153
1154    CHARACTER (LEN=*), INTENT(IN) ::  mode     !< statistical analysis mode
1155    INTEGER(iwp),      INTENT(IN) ::  sr       !<
1156    INTEGER(iwp),      INTENT(IN) ::  tn       !<
1157    INTEGER(iwp),      INTENT(IN) ::  dots_max !< maximum number of timeseries
1158
1159    IF ( gust_module_enabled )  CALL gust_statistics( mode, sr, tn, dots_max )
1160    IF ( air_chemistry       )  CALL chem_statistics( mode, sr, tn )
1161    IF ( user_module_enabled )  CALL user_statistics( mode, sr, tn )
1162
1163
1164 END SUBROUTINE module_interface_statistics
1165
1166
1167!------------------------------------------------------------------------------!
1168! Description:
1169! ------------
1170!> Read module-specific restart data globaly shared by all MPI ranks
1171!------------------------------------------------------------------------------!
1172 SUBROUTINE module_interface_rrd_global( found )
1173
1174
1175    LOGICAL, INTENT(INOUT) ::  found    !< flag if variable was found
1176
1177    IF ( .NOT. found )  CALL bio_rrd_global( found ) ! ToDo: change interface to pass variable
1178    IF ( .NOT. found )  CALL bcm_rrd_global( found ) ! ToDo: change interface to pass variable
1179    IF ( .NOT. found )  CALL flight_rrd_global( found ) ! ToDo: change interface to pass variable
1180    IF ( .NOT. found )  CALL gust_rrd_global( found ) ! ToDo: change interface to pass variable
1181    IF ( .NOT. found )  CALL ocean_rrd_global( found ) ! ToDo: change interface to pass variable
1182    IF ( .NOT. found )  CALL stg_rrd_global ( found ) ! ToDo: change interface to pass variable
1183    IF ( .NOT. found )  CALL wtm_rrd_global( found ) ! ToDo: change interface to pass variable
1184    IF ( .NOT. found )  CALL surface_data_output_rrd_global( found )
1185    IF ( .NOT. found )  CALL user_rrd_global( found ) ! ToDo: change interface to pass variable
1186
1187
1188 END SUBROUTINE module_interface_rrd_global
1189
1190
1191!------------------------------------------------------------------------------!
1192! Description:
1193! ------------
1194!> Write module-specific restart data globaly shared by all MPI ranks
1195!------------------------------------------------------------------------------!
1196 SUBROUTINE module_interface_wrd_global
1197
1198
1199    IF ( biometeorology )       CALL bio_wrd_global
1200    IF ( bulk_cloud_model )     CALL bcm_wrd_global
1201    IF ( virtual_flight )       CALL flight_wrd_global
1202    IF ( gust_module_enabled )  CALL gust_wrd_global
1203    IF ( ocean_mode )           CALL ocean_wrd_global
1204    IF ( syn_turb_gen )         CALL stg_wrd_global
1205    IF ( wind_turbine )         CALL wtm_wrd_global
1206    IF ( surface_output )       CALL surface_data_output_wrd_global
1207    IF ( user_module_enabled )  CALL user_wrd_global
1208
1209
1210 END SUBROUTINE module_interface_wrd_global
1211
1212
1213!------------------------------------------------------------------------------!
1214! Description:
1215! ------------
1216!> Read module-specific restart data specific to local MPI ranks
1217!------------------------------------------------------------------------------!
1218 SUBROUTINE module_interface_rrd_local( map_index,                             &
1219                                        nxlf, nxlc, nxl_on_file,               &
1220                                        nxrf, nxrc, nxr_on_file,               &
1221                                        nynf, nync, nyn_on_file,               &
1222                                        nysf, nysc, nys_on_file,               &
1223                                        tmp_2d, tmp_3d, found )
1224
1225
1226    INTEGER(iwp), INTENT(IN)  ::  map_index    !<
1227    INTEGER(iwp), INTENT(IN)  ::  nxlc         !<
1228    INTEGER(iwp), INTENT(IN)  ::  nxlf         !<
1229    INTEGER(iwp), INTENT(IN)  ::  nxl_on_file  !<
1230    INTEGER(iwp), INTENT(IN)  ::  nxrc         !<
1231    INTEGER(iwp), INTENT(IN)  ::  nxrf         !<
1232    INTEGER(iwp), INTENT(IN)  ::  nxr_on_file  !<
1233    INTEGER(iwp), INTENT(IN)  ::  nync         !<
1234    INTEGER(iwp), INTENT(IN)  ::  nynf         !<
1235    INTEGER(iwp), INTENT(IN)  ::  nyn_on_file  !<
1236    INTEGER(iwp), INTENT(IN)  ::  nysc         !<
1237    INTEGER(iwp), INTENT(IN)  ::  nysf         !<
1238    INTEGER(iwp), INTENT(IN)  ::  nys_on_file  !<
1239    LOGICAL,      INTENT(INOUT) ::  found        !< flag if variable was found
1240
1241    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp), INTENT(OUT) :: tmp_2d   !<
1242    REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp), INTENT(OUT) :: tmp_3d   !<
1243
1244
1245    IF ( .NOT. found ) CALL bio_rrd_local(                                     &
1246                               found                                           &
1247                            )
1248
1249    IF ( .NOT. found ) CALL bcm_rrd_local(                                     &
1250                               map_index,                                      &
1251                               nxlf, nxlc, nxl_on_file,                        &
1252                               nxrf, nxrc, nxr_on_file,                        &
1253                               nynf, nync, nyn_on_file,                        &
1254                               nysf, nysc, nys_on_file,                        &
1255                               tmp_2d, tmp_3d, found                           &
1256                            ) ! ToDo: change interface to pass variable
1257
1258    IF ( .NOT. found ) CALL chem_rrd_local(                                    &
1259                               map_index,                                      &
1260                               nxlf, nxlc, nxl_on_file,                        &
1261                               nxrf, nxrc, nxr_on_file,                        &
1262                               nynf, nync, nyn_on_file,                        &
1263                               nysf, nysc, nys_on_file,                        &
1264                               tmp_3d, found                                   &
1265                            ) ! ToDo: change interface to pass variable
1266
1267    IF ( .NOT. found ) CALL gust_rrd_local(                                    &
1268                               map_index,                                      &
1269                               nxlf, nxlc, nxl_on_file,                        &
1270                               nxrf, nxrc, nxr_on_file,                        &
1271                               nynf, nync, nyn_on_file,                        &
1272                               nysf, nysc, nys_on_file,                        &
1273                               tmp_2d, tmp_3d, found                           &
1274                            ) ! ToDo: change interface to pass variable
1275
1276    IF ( .NOT. found ) CALL lsm_rrd_local(                                     &
1277                               map_index,                                      &
1278                               nxlf, nxlc, nxl_on_file,                        &
1279                               nxrf, nxrc, nxr_on_file,                        &
1280                               nynf, nync, nyn_on_file,                        &
1281                               nysf, nysc, nys_on_file,                        &
1282                               tmp_2d, found                                   &
1283                            ) ! ToDo: change interface to pass variable
1284
1285    IF ( .NOT. found ) CALL ocean_rrd_local(                                   &
1286                               map_index,                                      &
1287                               nxlf, nxlc, nxl_on_file,                        &
1288                               nxrf, nxrc, nxr_on_file,                        &
1289                               nynf, nync, nyn_on_file,                        &
1290                               nysf, nysc, nys_on_file,                        &
1291                               tmp_3d, found                                   &
1292                            ) ! ToDo: change interface to pass variable
1293
1294    IF ( .NOT. found ) CALL radiation_rrd_local(                               &
1295                               map_index,                                      &
1296                               nxlf, nxlc, nxl_on_file,                        &
1297                               nxrf, nxrc, nxr_on_file,                        &
1298                               nynf, nync, nyn_on_file,                        &
1299                               nysf, nysc, nys_on_file,                        &
1300                               tmp_2d, tmp_3d, found                           &
1301                            ) ! ToDo: change interface to pass variable
1302
1303    IF ( .NOT. found ) CALL salsa_rrd_local(                                   &
1304                               map_index,                                      &
1305                               nxlf, nxlc, nxl_on_file,                        &
1306                               nxrf, nxrc, nxr_on_file,                        &
1307                               nynf, nync, nyn_on_file,                        &
1308                               nysf, nysc, nys_on_file,                        &
1309                               tmp_3d, found                                   &
1310                            ) ! ToDo: change interface to pass variable
1311
1312    IF ( .NOT. found ) CALL usm_rrd_local(                                     &
1313                               map_index,                                      &
1314                               nxlf, nxlc, nxl_on_file,                        &
1315                               nxrf, nxr_on_file,                              &
1316                               nynf, nyn_on_file,                              &
1317                               nysf, nysc, nys_on_file,                        &
1318                               found                                           &
1319                            ) ! ToDo: change interface to pass variable
1320!
1321!-- Surface data do not need overlap data, so do not pass these information.
1322    IF ( .NOT. found ) CALL surface_data_output_rrd_local( found )
1323                           
1324    IF ( .NOT. found ) CALL user_rrd_local(                                    &
1325                               map_index,                                      &
1326                               nxlf, nxlc, nxl_on_file,                        &
1327                               nxrf, nxrc, nxr_on_file,                        &
1328                               nynf, nync, nyn_on_file,                        &
1329                               nysf, nysc, nys_on_file,                        &
1330                               tmp_3d, found                                   &
1331                            ) ! ToDo: change interface to pass variable
1332
1333
1334 END SUBROUTINE module_interface_rrd_local
1335
1336
1337!------------------------------------------------------------------------------!
1338! Description:
1339! ------------
1340!> Write module-specific restart data specific to local MPI ranks
1341!------------------------------------------------------------------------------!
1342 SUBROUTINE module_interface_wrd_local
1343
1344
1345    IF ( biometeorology )       CALL bio_wrd_local
1346    IF ( bulk_cloud_model )     CALL bcm_wrd_local
1347    IF ( air_chemistry )        CALL chem_wrd_local
1348    IF ( gust_module_enabled )  CALL gust_wrd_local
1349    IF ( land_surface )         CALL lsm_wrd_local
1350    IF ( ocean_mode )           CALL ocean_wrd_local
1351    IF ( radiation )            CALL radiation_wrd_local
1352    IF ( salsa )                CALL salsa_wrd_local
1353    IF ( urban_surface )        CALL usm_wrd_local
1354    IF ( surface_output )       CALL surface_data_output_wrd_local
1355    IF ( user_module_enabled )  CALL user_wrd_local
1356
1357
1358 END SUBROUTINE module_interface_wrd_local
1359
1360
1361!------------------------------------------------------------------------------!
1362! Description:
1363! ------------
1364!> Perform module-specific last actions before the program terminates
1365!------------------------------------------------------------------------------!
1366 SUBROUTINE module_interface_last_actions
1367
1368
1369    IF ( virtual_measurement )  CALL vm_last_actions
1370    IF ( user_module_enabled )  CALL user_last_actions
1371
1372
1373 END SUBROUTINE module_interface_last_actions
1374
1375
1376 END MODULE module_interface
Note: See TracBrowser for help on using the repository browser.