!> @file dynamics_mod.f90 !--------------------------------------------------------------------------------------------------! ! This file is part of the PALM model system. ! ! PALM is free software: you can redistribute it and/or modify it under the ! terms of the GNU General Public License as published by the Free Software ! Foundation, either version 3 of the License, or (at your option) any later ! version. ! ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License along with ! PALM. If not, see . ! ! Copyright 1997-2019 Leibniz Universitaet Hannover !--------------------------------------------------------------------------------------------------! ! ! Current revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: dynamics_mod.f90 4097 2019-07-15 11:59:11Z suehring $ ! Avoid overlong lines - limit is 132 characters per line ! ! 4047 2019-06-21 18:58:09Z knoop ! Initial introduction of the dynamics module with only dynamics_swap_timelevel implemented ! ! ! Description: ! ------------ !> This module contains the dynamics of PALM. !--------------------------------------------------------------------------------------------------! MODULE dynamics_mod USE arrays_3d, & ONLY: pt, pt_1, pt_2, pt_p, & q, q_1, q_2, q_p, & s, s_1, s_2, s_p, & u, u_1, u_2, u_p, & v, v_1, v_2, v_p, & w, w_1, w_2, w_p USE control_parameters, & ONLY: length, & restart_string, & humidity, & neutral, & passive_scalar USE indices, & ONLY: nbgp, & nxl, & nxr, & nys, & nyn, & nzb, & nzt USE kinds IMPLICIT NONE LOGICAL :: dynamics_module_enabled = .FALSE. !< SAVE PRIVATE ! !-- Public functions PUBLIC & dynamics_parin, & dynamics_check_parameters, & dynamics_check_data_output_ts, & dynamics_check_data_output_pr, & dynamics_check_data_output, & dynamics_init_masks, & dynamics_define_netcdf_grid, & dynamics_init_arrays, & dynamics_init, & dynamics_init_checks, & dynamics_header, & dynamics_actions, & dynamics_non_advective_processes, & dynamics_exchange_horiz, & dynamics_prognostic_equations, & dynamics_swap_timelevel, & dynamics_3d_data_averaging, & dynamics_data_output_2d, & dynamics_data_output_3d, & dynamics_statistics, & dynamics_rrd_global, & dynamics_rrd_local, & dynamics_wrd_global, & dynamics_wrd_local, & dynamics_last_actions ! !-- Public parameters, constants and initial values PUBLIC & dynamics_module_enabled INTERFACE dynamics_parin MODULE PROCEDURE dynamics_parin END INTERFACE dynamics_parin INTERFACE dynamics_check_parameters MODULE PROCEDURE dynamics_check_parameters END INTERFACE dynamics_check_parameters INTERFACE dynamics_check_data_output_ts MODULE PROCEDURE dynamics_check_data_output_ts END INTERFACE dynamics_check_data_output_ts INTERFACE dynamics_check_data_output_pr MODULE PROCEDURE dynamics_check_data_output_pr END INTERFACE dynamics_check_data_output_pr INTERFACE dynamics_check_data_output MODULE PROCEDURE dynamics_check_data_output END INTERFACE dynamics_check_data_output INTERFACE dynamics_init_masks MODULE PROCEDURE dynamics_init_masks END INTERFACE dynamics_init_masks INTERFACE dynamics_define_netcdf_grid MODULE PROCEDURE dynamics_define_netcdf_grid END INTERFACE dynamics_define_netcdf_grid INTERFACE dynamics_init_arrays MODULE PROCEDURE dynamics_init_arrays END INTERFACE dynamics_init_arrays INTERFACE dynamics_init MODULE PROCEDURE dynamics_init END INTERFACE dynamics_init INTERFACE dynamics_init_checks MODULE PROCEDURE dynamics_init_checks END INTERFACE dynamics_init_checks INTERFACE dynamics_header MODULE PROCEDURE dynamics_header END INTERFACE dynamics_header INTERFACE dynamics_actions MODULE PROCEDURE dynamics_actions MODULE PROCEDURE dynamics_actions_ij END INTERFACE dynamics_actions INTERFACE dynamics_non_advective_processes MODULE PROCEDURE dynamics_non_advective_processes MODULE PROCEDURE dynamics_non_advective_processes_ij END INTERFACE dynamics_non_advective_processes INTERFACE dynamics_exchange_horiz MODULE PROCEDURE dynamics_exchange_horiz END INTERFACE dynamics_exchange_horiz INTERFACE dynamics_prognostic_equations MODULE PROCEDURE dynamics_prognostic_equations MODULE PROCEDURE dynamics_prognostic_equations_ij END INTERFACE dynamics_prognostic_equations INTERFACE dynamics_swap_timelevel MODULE PROCEDURE dynamics_swap_timelevel END INTERFACE dynamics_swap_timelevel INTERFACE dynamics_3d_data_averaging MODULE PROCEDURE dynamics_3d_data_averaging END INTERFACE dynamics_3d_data_averaging INTERFACE dynamics_data_output_2d MODULE PROCEDURE dynamics_data_output_2d END INTERFACE dynamics_data_output_2d INTERFACE dynamics_data_output_3d MODULE PROCEDURE dynamics_data_output_3d END INTERFACE dynamics_data_output_3d INTERFACE dynamics_statistics MODULE PROCEDURE dynamics_statistics END INTERFACE dynamics_statistics INTERFACE dynamics_rrd_global MODULE PROCEDURE dynamics_rrd_global END INTERFACE dynamics_rrd_global INTERFACE dynamics_rrd_local MODULE PROCEDURE dynamics_rrd_local END INTERFACE dynamics_rrd_local INTERFACE dynamics_wrd_global MODULE PROCEDURE dynamics_wrd_global END INTERFACE dynamics_wrd_global INTERFACE dynamics_wrd_local MODULE PROCEDURE dynamics_wrd_local END INTERFACE dynamics_wrd_local INTERFACE dynamics_last_actions MODULE PROCEDURE dynamics_last_actions END INTERFACE dynamics_last_actions CONTAINS !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read module-specific namelist !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_parin CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file NAMELIST /dynamics_parameters/ & dynamics_module_enabled line = ' ' ! !-- Try to find module-specific namelist REWIND ( 11 ) line = ' ' DO WHILE ( INDEX( line, '&dynamics_parameters' ) == 0 ) READ ( 11, '(A)', END=12 ) line ENDDO BACKSPACE ( 11 ) !-- Set default module switch to true dynamics_module_enabled = .TRUE. !-- Read user-defined namelist READ ( 11, dynamics_parameters, ERR = 10 ) GOTO 12 10 BACKSPACE( 11 ) READ( 11 , '(A)') line CALL parin_fail_message( 'dynamics_parameters', line ) 12 CONTINUE END SUBROUTINE dynamics_parin !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Check control parameters and deduce further quantities. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_check_parameters END SUBROUTINE dynamics_check_parameters !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Set module-specific timeseries units and labels !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit ) INTEGER(iwp), INTENT(IN) :: dots_max INTEGER(iwp), INTENT(INOUT) :: dots_num CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit ! !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( dots_num == 0 .OR. dots_label(1)(1:1) == ' ' .OR. dots_unit(1)(1:1) == ' ' ) CONTINUE END SUBROUTINE dynamics_check_data_output_ts !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Set the unit of module-specific profile output quantities. For those variables not recognized, !> the parameter unit is set to "illegal", which tells the calling routine that the output variable !> is not defined and leads to a program abort. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_check_data_output_pr( variable, var_count, unit, dopr_unit ) CHARACTER (LEN=*) :: unit !< CHARACTER (LEN=*) :: variable !< CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit INTEGER(iwp) :: var_count !< ! !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( unit(1:1) == ' ' .OR. dopr_unit(1:1) == ' ' .OR. var_count == 0 ) CONTINUE SELECT CASE ( TRIM( variable ) ) ! CASE ( 'var_name' ) CASE DEFAULT unit = 'illegal' END SELECT END SUBROUTINE dynamics_check_data_output_pr !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Set the unit of module-specific output quantities. For those variables not recognized, !> the parameter unit is set to "illegal", which tells the calling routine that the output variable !< is not defined and leads to a program abort. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_check_data_output( variable, unit ) CHARACTER (LEN=*) :: unit !< CHARACTER (LEN=*) :: variable !< SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT unit = 'illegal' END SELECT END SUBROUTINE dynamics_check_data_output !------------------------------------------------------------------------------! ! ! Description: ! ------------ !> Initialize module-specific masked output !------------------------------------------------------------------------------! SUBROUTINE dynamics_init_masks( variable, unit ) CHARACTER (LEN=*) :: unit !< CHARACTER (LEN=*) :: variable !< SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT unit = 'illegal' END SELECT END SUBROUTINE dynamics_init_masks !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Initialize module-specific arrays !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_init_arrays END SUBROUTINE dynamics_init_arrays !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Execution of module-specific initializing actions !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_init END SUBROUTINE dynamics_init !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Perform module-specific post-initialization checks !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_init_checks END SUBROUTINE dynamics_init_checks !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Set the grids on which module-specific output quantities are defined. Allowed values for !> grid_x are "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw". !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z ) CHARACTER (LEN=*) :: grid_x !< CHARACTER (LEN=*) :: grid_y !< CHARACTER (LEN=*) :: grid_z !< CHARACTER (LEN=*) :: variable !< LOGICAL :: found !< SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT found = .FALSE. grid_x = 'none' grid_y = 'none' grid_z = 'none' END SELECT END SUBROUTINE dynamics_define_netcdf_grid !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Print a header with module-specific information. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_header( io ) INTEGER(iwp) :: io !< ! !-- If no module-specific variables are read from the namelist-file, no information will be printed. IF ( .NOT. dynamics_module_enabled ) THEN WRITE ( io, 100 ) RETURN ENDIF ! !-- Printing the information. WRITE ( io, 110 ) ! !-- Format-descriptors 100 FORMAT (//' *** dynamic module disabled'/) 110 FORMAT (//1X,78('#') & //' User-defined variables and actions:'/ & ' -----------------------------------'//) END SUBROUTINE dynamics_header !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Execute module-specific actions for all grid points !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_actions( location ) CHARACTER (LEN=*) :: location !< ! INTEGER(iwp) :: i !< ! INTEGER(iwp) :: j !< ! INTEGER(iwp) :: k !< ! !-- Here the user-defined actions follow !-- No calls for single grid points are allowed at locations before and !-- after the timestep, since these calls are not within an i,j-loop SELECT CASE ( location ) CASE ( 'before_timestep' ) CASE ( 'before_prognostic_equations' ) CASE ( 'after_integration' ) CASE ( 'after_timestep' ) CASE ( 'u-tendency' ) CASE ( 'v-tendency' ) CASE ( 'w-tendency' ) CASE ( 'pt-tendency' ) CASE ( 'sa-tendency' ) CASE ( 'e-tendency' ) CASE ( 'q-tendency' ) CASE ( 's-tendency' ) CASE DEFAULT CONTINUE END SELECT END SUBROUTINE dynamics_actions !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Execute module-specific actions for grid point i,j !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_actions_ij( i, j, location ) CHARACTER (LEN=*) :: location INTEGER(iwp) :: i INTEGER(iwp) :: j ! !-- Here the user-defined actions follow SELECT CASE ( location ) CASE ( 'u-tendency' ) !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( i + j < 0 ) CONTINUE CASE ( 'v-tendency' ) CASE ( 'w-tendency' ) CASE ( 'pt-tendency' ) CASE ( 'sa-tendency' ) CASE ( 'e-tendency' ) CASE ( 'q-tendency' ) CASE ( 's-tendency' ) CASE DEFAULT CONTINUE END SELECT END SUBROUTINE dynamics_actions_ij !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Compute module-specific non-advective processes for all grid points !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_non_advective_processes END SUBROUTINE dynamics_non_advective_processes !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Compute module-specific non-advective processes for grid points i,j !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_non_advective_processes_ij( i, j ) INTEGER(iwp) :: i !< INTEGER(iwp) :: j !< ! !-- Next line is just to avoid compiler warnings about unused variables. You may remove it. IF ( i + j < 0 ) CONTINUE END SUBROUTINE dynamics_non_advective_processes_ij !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Perform module-specific horizontal boundary exchange !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_exchange_horiz END SUBROUTINE dynamics_exchange_horiz !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Compute module-specific prognostic equations for all grid points !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_prognostic_equations END SUBROUTINE dynamics_prognostic_equations !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Compute module-specific prognostic equations for grid point i,j !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_prognostic_equations_ij( i, j, i_omp_start, tn ) INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction INTEGER(iwp), INTENT(IN) :: i_omp_start !< first loop index of i-loop in prognostic_equations INTEGER(iwp), INTENT(IN) :: tn !< task number of openmp task ! !-- Next line is just to avoid compiler warnings about unused variables. You may remove it. IF ( i + j + i_omp_start + tn < 0 ) CONTINUE END SUBROUTINE dynamics_prognostic_equations_ij !------------------------------------------------------------------------------! ! Description: ! ------------ !> Swap timelevels of module-specific array pointers !------------------------------------------------------------------------------! SUBROUTINE dynamics_swap_timelevel ( mod_count ) INTEGER, INTENT(IN) :: mod_count SELECT CASE ( mod_count ) CASE ( 0 ) u => u_1; u_p => u_2 v => v_1; v_p => v_2 w => w_1; w_p => w_2 IF ( .NOT. neutral ) THEN pt => pt_1; pt_p => pt_2 ENDIF IF ( humidity ) THEN q => q_1; q_p => q_2 ENDIF IF ( passive_scalar ) THEN s => s_1; s_p => s_2 ENDIF CASE ( 1 ) u => u_2; u_p => u_1 v => v_2; v_p => v_1 w => w_2; w_p => w_1 IF ( .NOT. neutral ) THEN pt => pt_2; pt_p => pt_1 ENDIF IF ( humidity ) THEN q => q_2; q_p => q_1 ENDIF IF ( passive_scalar ) THEN s => s_2; s_p => s_1 ENDIF END SELECT END SUBROUTINE dynamics_swap_timelevel !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Sum up and time-average module-specific output quantities !> as well as allocate the array necessary for storing the average. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_3d_data_averaging( mode, variable ) CHARACTER (LEN=*) :: mode !< CHARACTER (LEN=*) :: variable !< IF ( mode == 'allocate' ) THEN SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT CONTINUE END SELECT ELSEIF ( mode == 'sum' ) THEN SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT CONTINUE END SELECT ELSEIF ( mode == 'average' ) THEN SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) END SELECT ENDIF END SUBROUTINE dynamics_3d_data_averaging !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Resorts the module-specific output quantity with indices (k,j,i) to a !> temporary array with indices (i,j,k) and sets the grid on which it is defined. !> Allowed values for grid are "zu" and "zw". !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_data_output_2d( av, variable, found, grid, mode, local_pf, & two_d, nzb_do, nzt_do, fill_value ) CHARACTER (LEN=*) :: grid !< CHARACTER (LEN=*), INTENT(IN) :: mode !< either 'xy', 'xz' or 'yz' CHARACTER (LEN=*) :: variable !< INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data ! INTEGER(iwp) :: i !< grid index along x-direction ! INTEGER(iwp) :: j !< grid index along y-direction ! INTEGER(iwp) :: k !< grid index along z-direction ! INTEGER(iwp) :: m !< running index surface elements INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb) INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1) LOGICAL :: found !< LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) REAL(wp), INTENT(IN) :: fill_value REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< ! !-- Next line is just to avoid compiler warnings about unused variables. You may remove it. IF ( two_d .AND. av + LEN( mode ) + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE found = .TRUE. SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' ) CASE DEFAULT found = .FALSE. grid = 'none' END SELECT END SUBROUTINE dynamics_data_output_2d !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Resorts the module-specific output quantity with indices (k,j,i) !> to a temporary array with indices (i,j,k). !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do ) CHARACTER (LEN=*) :: variable !< INTEGER(iwp) :: av !< ! INTEGER(iwp) :: i !< ! INTEGER(iwp) :: j !< ! INTEGER(iwp) :: k !< INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) LOGICAL :: found !< REAL(wp), INTENT(IN) :: fill_value !< value for the _FillValue attribute REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< ! !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( av + local_pf(nxl,nys,nzb_do) + fill_value < 0.0 ) CONTINUE found = .TRUE. SELECT CASE ( TRIM( variable ) ) ! CASE ( 'u2' ) CASE DEFAULT found = .FALSE. END SELECT END SUBROUTINE dynamics_data_output_3d !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Calculation of module-specific statistics, i.e. horizontally averaged profiles and time series. !> This is called for every statistic region sr, but at least for the region "total domain" (sr=0). !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_statistics( mode, sr, tn ) CHARACTER (LEN=*) :: mode !< ! INTEGER(iwp) :: i !< ! INTEGER(iwp) :: j !< ! INTEGER(iwp) :: k !< INTEGER(iwp) :: sr !< INTEGER(iwp) :: tn !< ! !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( sr == 0 .OR. tn == 0 ) CONTINUE IF ( mode == 'profiles' ) THEN ELSEIF ( mode == 'time_series' ) THEN ENDIF END SUBROUTINE dynamics_statistics !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read module-specific global restart data. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_rrd_global( found ) LOGICAL, INTENT(OUT) :: found found = .TRUE. SELECT CASE ( restart_string(1:length) ) CASE ( 'global_paramter' ) ! READ ( 13 ) global_parameter CASE DEFAULT found = .FALSE. END SELECT END SUBROUTINE dynamics_rrd_global !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Read module-specific processor specific restart data from file(s). !> Subdomain index limits on file are given by nxl_on_file, etc. !> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the subdomain on file (f) !> to the subdomain of the current PE (c). They have been calculated in routine rrd_local. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & nyn_on_file, nysf, nysc, nys_on_file, tmp_2d, tmp_3d, found ) INTEGER(iwp) :: k !< INTEGER(iwp) :: nxlc !< INTEGER(iwp) :: nxlf !< INTEGER(iwp) :: nxl_on_file !< INTEGER(iwp) :: nxrc !< INTEGER(iwp) :: nxrf !< INTEGER(iwp) :: nxr_on_file !< INTEGER(iwp) :: nync !< INTEGER(iwp) :: nynf !< INTEGER(iwp) :: nyn_on_file !< INTEGER(iwp) :: nysc !< INTEGER(iwp) :: nysf !< INTEGER(iwp) :: nys_on_file !< LOGICAL, INTENT(OUT) :: found REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !< REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< ! !-- Next line is to avoid compiler warning about unused variables. Please remove. IF ( k + nxlc + nxlf + nxrc + nxrf + nync + nynf + nysc + nysf + & tmp_2d(nys_on_file,nxl_on_file) + & tmp_3d(nzb,nys_on_file,nxl_on_file) < 0.0 ) CONTINUE ! !-- Here the reading of user-defined restart data follows: !-- Sample for user-defined output found = .TRUE. SELECT CASE ( restart_string(1:length) ) ! CASE ( 'u2_av' ) CASE DEFAULT found = .FALSE. END SELECT END SUBROUTINE dynamics_rrd_local !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Writes global module-specific restart data into binary file(s) for restart runs. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_wrd_global END SUBROUTINE dynamics_wrd_global !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Writes processor specific and module-specific restart data into binary file(s) for restart runs. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_wrd_local END SUBROUTINE dynamics_wrd_local !--------------------------------------------------------------------------------------------------! ! Description: ! ------------ !> Execute module-specific actions at the very end of the program. !--------------------------------------------------------------------------------------------------! SUBROUTINE dynamics_last_actions END SUBROUTINE dynamics_last_actions END MODULE dynamics_mod