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

Last change on this file since 3766 was 3766, checked in by raasch, 5 years ago

unused_variables removed, bugfix in im_define_netcdf_grid argument list, trim added to avoid truncation compiler warnings, save attribute added to local targets to avoid outlive pointer target warning, first argument removed from module_interface_rrd_*, file module_interface reformatted with respect to coding standards, bugfix in surface_data_output_rrd_local (variable k removed)

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