Changeset 4226 for palm


Ignore:
Timestamp:
Sep 10, 2019 5:03:24 PM (5 years ago)
Author:
suehring
Message:

Offline nesting: data input modularized; time variable is defined relative to time_utc_init, so that input data is correctly mapped to actual model time; checks rephrased and new checks for the time dimension added; Netcdf input: routine to retrieve dimension length renamed

Location:
palm/trunk/SOURCE
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/nesting_offl_mod.f90

    r4182 r4226  
    2525! -----------------
    2626! $Id$
     27! - Data input moved into nesting_offl_mod
     28! - check rephrased
     29! - time variable is now relative to time_utc_init
     30! - Define module specific data type for offline nesting in nesting_offl_mod
     31!
     32! 4182 2019-08-22 15:20:23Z scharf
    2733! Corrected "Former revisions" section
    2834!
     
    99105
    100106    USE arrays_3d,                                                             &
    101         ONLY:  dzw, e, diss, pt, pt_init, q, q_init, s, u, u_init, ug, v,      &
    102                v_init, vg, w, zu, zw
     107        ONLY:  dzw,                                                            &
     108               e,                                                              &
     109               diss,                                                           &
     110               pt,                                                             &
     111               pt_init,                                                        &
     112               q,                                                              &
     113               q_init,                                                         &
     114               rdf,                                                            &
     115               rdf_sc,                                                         &
     116               s,                                                              &
     117               u,                                                              &
     118               u_init,                                                         &
     119               ug,                                                             &
     120               v,                                                              &
     121               v_init,                                                         &
     122               vg,                                                             &
     123               w,                                                              &
     124               zu,                                                             &
     125               zw
     126
     127    USE basic_constants_and_equations_mod,                                     &
     128           ONLY:  g,                                                           &
     129                  pi
    103130                 
    104131    USE chem_modules,                                                          &
     
    111138               bc_dirichlet_r,                                                 &
    112139               bc_dirichlet_s,                                                 &
     140               coupling_char,                                                  &
    113141               dt_3d,                                                          &
    114142               dz,                                                             &
     
    132160               
    133161    USE cpulog,                                                                &
    134         ONLY:  cpu_log, log_point
     162        ONLY:  cpu_log,                                                        &
     163               log_point,                                                      &
     164               log_point_s
     165
     166    USE date_and_time_mod,                                                     &
     167        ONLY:  time_utc_init
    135168
    136169    USE grid_variables
     
    145178
    146179    USE netcdf_data_input_mod,                                                 &
    147         ONLY:  nest_offl
    148        
     180        ONLY:  check_existence,                                                &
     181               close_input_file,                                               &
     182               get_dimension_length,                                           &
     183               get_variable,                                                   &
     184               get_variable_pr,                                                &
     185               input_pids_dynamic,                                             &
     186               inquire_num_variables,                                          &
     187               inquire_variable_names,                                         &
     188               input_file_dynamic,                                             &
     189               num_var_pids,                                                   &
     190               open_read_file,                                                 &
     191               pids_id
     192
    149193    USE pegrid
    150194
     195    IMPLICIT NONE
     196
     197!
     198!-- Define data type for nesting in larger-scale models like COSMO.
     199!-- Data type comprises u, v, w, pt, and q at lateral and top boundaries.
     200    TYPE nest_offl_type
     201
     202       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'  !< leading substring for variables at left boundary
     203       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_' !< leading substring for variables at north boundary 
     204       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_' !< leading substring for variables at right boundary 
     205       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_' !< leading substring for variables at south boundary
     206       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'   !< leading substring for variables at top boundary
     207
     208       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names         !< list of variable in dynamic input file
     209       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_l  !< names of mesoscale nested chemistry variables at left boundary
     210       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_n  !< names of mesoscale nested chemistry variables at north boundary
     211       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_r  !< names of mesoscale nested chemistry variables at right boundary
     212       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_s  !< names of mesoscale nested chemistry variables at south boundary
     213       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_t  !< names of mesoscale nested chemistry variables at top boundary
     214
     215       INTEGER(iwp) ::  nt     !< number of time levels in dynamic input file
     216       INTEGER(iwp) ::  nzu    !< number of vertical levels on scalar grid in dynamic input file
     217       INTEGER(iwp) ::  nzw    !< number of vertical levels on w grid in dynamic input file
     218       INTEGER(iwp) ::  tind   !< time index for reference time in mesoscale-offline nesting
     219       INTEGER(iwp) ::  tind_p !< time index for following time in mesoscale-offline nesting
     220
     221       LOGICAL      ::  init         = .FALSE. !< flag indicating that offline nesting is already initialized
     222
     223       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_l !< flags inidicating whether left boundary data for chemistry is in dynamic input file 
     224       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_n !< flags inidicating whether north boundary data for chemistry is in dynamic input file
     225       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_r !< flags inidicating whether right boundary data for chemistry is in dynamic input file
     226       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_s !< flags inidicating whether south boundary data for chemistry is in dynamic input file
     227       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_t !< flags inidicating whether top boundary data for chemistry is in dynamic input file
     228
     229       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surface_pressure !< time dependent surface pressure
     230       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time             !< time levels in dynamic input file
     231       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos         !< vertical levels at scalar grid in dynamic input file
     232       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos         !< vertical levels at w grid in dynamic input file
     233
     234       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug         !< domain-averaged geostrophic component
     235       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg         !< domain-averaged geostrophic component
     236
     237       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_left   !< u-component at left boundary
     238       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_left   !< v-component at left boundary
     239       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_left   !< w-component at left boundary
     240       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_left   !< mixing ratio at left boundary
     241       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_left  !< potentital temperautre at left boundary
     242
     243       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_north  !< u-component at north boundary
     244       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_north  !< v-component at north boundary
     245       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_north  !< w-component at north boundary
     246       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_north  !< mixing ratio at north boundary
     247       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_north !< potentital temperautre at north boundary
     248
     249       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_right  !< u-component at right boundary
     250       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_right  !< v-component at right boundary
     251       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_right  !< w-component at right boundary
     252       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_right  !< mixing ratio at right boundary
     253       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_right !< potentital temperautre at right boundary
     254
     255       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_south  !< u-component at south boundary
     256       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_south  !< v-component at south boundary
     257       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_south  !< w-component at south boundary
     258       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_south  !< mixing ratio at south boundary
     259       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_south !< potentital temperautre at south boundary
     260
     261       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
     262       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
     263       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
     264       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
     265       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
     266       
     267       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_left   !< chemical species at left boundary
     268       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_north  !< chemical species at left boundary
     269       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_right  !< chemical species at left boundary
     270       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_south  !< chemical species at left boundary
     271       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_top    !< chemical species at left boundary
     272
     273    END TYPE nest_offl_type
     274
     275    REAL(wp) ::  fac_dt              !< interpolation factor
    151276    REAL(wp) ::  zi_ribulk = 0.0_wp  !< boundary-layer depth according to bulk Richardson criterion, i.e. the height where Ri_bulk exceeds the critical
    152                                      !< bulk Richardson number of 0.25
     277                                     !< bulk Richardson number of 0.2
     278
     279    TYPE(nest_offl_type) ::  nest_offl  !< data structure for data input at lateral and top boundaries (provided by Inifor)
    153280   
    154281    SAVE
     
    159286           nesting_offl_calc_zi,                                               &
    160287           nesting_offl_check_parameters,                                      &
     288           nesting_offl_geostrophic_wind,                                      &
    161289           nesting_offl_header,                                                &
    162290           nesting_offl_init,                                                  &
     291           nesting_offl_input,                                                 &
     292           nesting_offl_interpolation_factor,                                  &
    163293           nesting_offl_mass_conservation,                                     &
    164294           nesting_offl_parin
     
    178308       MODULE PROCEDURE nesting_offl_check_parameters
    179309    END INTERFACE nesting_offl_check_parameters
     310
     311    INTERFACE nesting_offl_geostrophic_wind
     312       MODULE PROCEDURE nesting_offl_geostrophic_wind
     313    END INTERFACE nesting_offl_geostrophic_wind
    180314   
    181315    INTERFACE nesting_offl_header
     
    186320       MODULE PROCEDURE nesting_offl_init
    187321    END INTERFACE nesting_offl_init
     322
     323    INTERFACE nesting_offl_input
     324       MODULE PROCEDURE nesting_offl_input
     325    END INTERFACE nesting_offl_input
     326
     327    INTERFACE nesting_offl_interpolation_factor
     328       MODULE PROCEDURE nesting_offl_interpolation_factor
     329    END INTERFACE nesting_offl_interpolation_factor
    188330           
    189331    INTERFACE nesting_offl_mass_conservation
     
    197339 CONTAINS
    198340
     341!------------------------------------------------------------------------------!
     342! Description:
     343! ------------
     344!> Reads data at lateral and top boundaries derived from larger-scale model.
     345!------------------------------------------------------------------------------!
     346    SUBROUTINE nesting_offl_input
     347
     348       INTEGER(iwp) ::  n   !< running index for chemistry variables
     349       INTEGER(iwp) ::  t   !< running index time dimension
     350
     351!
     352!--    Initialize INIFOR forcing in first call.
     353       IF ( .NOT. nest_offl%init )  THEN
     354#if defined ( __netcdf )
     355!
     356!--       Open file in read-only mode
     357          CALL open_read_file( TRIM( input_file_dynamic ) //                   &
     358                               TRIM( coupling_char ), pids_id )
     359!
     360!--       At first, inquire all variable names.
     361          CALL inquire_num_variables( pids_id, num_var_pids )
     362!
     363!--       Allocate memory to store variable names.
     364          ALLOCATE( nest_offl%var_names(1:num_var_pids) )
     365          CALL inquire_variable_names( pids_id, nest_offl%var_names )
     366!
     367!--       Read time dimension, allocate memory and finally read time array
     368          CALL get_dimension_length( pids_id, nest_offl%nt, 'time' )
     369
     370          IF ( check_existence( nest_offl%var_names, 'time' ) )  THEN
     371             ALLOCATE( nest_offl%time(0:nest_offl%nt-1) )
     372             CALL get_variable( pids_id, 'time', nest_offl%time )
     373          ENDIF
     374!
     375!--       Read vertical dimension of scalar und w grid
     376          CALL get_dimension_length( pids_id, nest_offl%nzu, 'z' )
     377          CALL get_dimension_length( pids_id, nest_offl%nzw, 'zw' )
     378
     379          IF ( check_existence( nest_offl%var_names, 'z' ) )  THEN
     380             ALLOCATE( nest_offl%zu_atmos(1:nest_offl%nzu) )
     381             CALL get_variable( pids_id, 'z', nest_offl%zu_atmos )
     382          ENDIF
     383          IF ( check_existence( nest_offl%var_names, 'zw' ) )  THEN
     384             ALLOCATE( nest_offl%zw_atmos(1:nest_offl%nzw) )
     385             CALL get_variable( pids_id, 'zw', nest_offl%zw_atmos )
     386          ENDIF
     387!
     388!--       Read surface pressure
     389          IF ( check_existence( nest_offl%var_names,                           &
     390                                'surface_forcing_surface_pressure' ) )  THEN
     391             ALLOCATE( nest_offl%surface_pressure(0:nest_offl%nt-1) )
     392             CALL get_variable( pids_id,                                       &
     393                                'surface_forcing_surface_pressure',            &
     394                                nest_offl%surface_pressure )
     395          ENDIF
     396!
     397!--       Close input file
     398          CALL close_input_file( pids_id )
     399#endif
     400       ENDIF
     401!
     402!--    Check if dynamic driver data input is required.
     403       IF ( nest_offl%time(nest_offl%tind_p) <=                                &
     404            MAX( time_since_reference_point, 0.0_wp) + time_utc_init  .OR.                   &
     405            .NOT.  nest_offl%init )  THEN
     406          CONTINUE
     407!
     408!--    Return otherwise
     409       ELSE
     410          RETURN
     411       ENDIF
     412!
     413!--    CPU measurement
     414       CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'start' )
     415
     416!
     417!--    Obtain time index for current point in time. Note, the time coordinate
     418!--    in the input file is relative to time_utc_init. Since time_since_...
     419!--    is negativ when spinup is used, use MAX function to obtain correct
     420!--    time at the beginning.
     421       nest_offl%tind = MINLOC( ABS( nest_offl%time - (                        &
     422                                     time_utc_init +                           &
     423                                     MAX( time_since_reference_point, 0.0_wp) )&
     424                                   ), DIM = 1 ) - 1
     425       nest_offl%tind_p = nest_offl%tind + 1
     426!
     427!--    Open file in read-only mode
     428#if defined ( __netcdf )
     429       CALL open_read_file( TRIM( input_file_dynamic ) //                      &
     430                            TRIM( coupling_char ), pids_id )
     431!
     432!--    Read geostrophic wind components
     433       DO  t = nest_offl%tind, nest_offl%tind_p
     434          CALL get_variable_pr( pids_id, 'ls_forcing_ug', t+1,                 &
     435                                nest_offl%ug(t-nest_offl%tind,nzb+1:nzt) )
     436          CALL get_variable_pr( pids_id, 'ls_forcing_vg', t+1,                 &
     437                                nest_offl%vg(t-nest_offl%tind,nzb+1:nzt) )
     438       ENDDO
     439!
     440!--    Read data at lateral and top boundaries. Please note, at left and
     441!--    right domain boundary, yz-layers are read for u, v, w, pt and q.
     442!--    For the v-component, the data starts at nysv, while for the other
     443!--    quantities the data starts at nys. This is equivalent at the north
     444!--    and south domain boundary for the u-component.
     445!--    Note, lateral data is also accessed by parallel IO, which is the reason
     446!--    why different arguments are passed depending on the boundary control
     447!--    flags. Cores that do not belong to the respective boundary just make
     448!--    a dummy read with count = 0, just in order to participate the collective
     449!--    operation.
     450!--    Read data for western boundary   
     451       CALL get_variable( pids_id, 'ls_forcing_left_u',                        &
     452                          nest_offl%u_left,                                    & ! array to be read
     453                          MERGE( nys+1, 1, bc_dirichlet_l),                    & ! start index y direction
     454                          MERGE( nzb+1, 1, bc_dirichlet_l),                    & ! start index z direction
     455                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         & ! start index time dimension
     456                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                & ! number of elements along y
     457                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),            & ! number of elements alogn z
     458                          MERGE( 2, 0, bc_dirichlet_l),                        & ! number of time steps (2 or 0)
     459                          .TRUE. )                                               ! parallel IO when compiled accordingly
     460     
     461       CALL get_variable( pids_id, 'ls_forcing_left_v',                        &
     462                          nest_offl%v_left,                                    &
     463                          MERGE( nysv, 1, bc_dirichlet_l),                     &
     464                          MERGE( nzb+1, 1, bc_dirichlet_l),                    &
     465                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         &
     466                          MERGE( nyn-nysv+1, 0, bc_dirichlet_l),               &
     467                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),            &
     468                          MERGE( 2, 0, bc_dirichlet_l),                        &
     469                          .TRUE. )                                       
     470
     471       CALL get_variable( pids_id, 'ls_forcing_left_w',                        &
     472                          nest_offl%w_left,                                    &
     473                          MERGE( nys+1, 1, bc_dirichlet_l),                    &
     474                          MERGE( nzb+1, 1, bc_dirichlet_l),                    &
     475                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         &
     476                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                &
     477                          MERGE( nest_offl%nzw, 0, bc_dirichlet_l),            &
     478                          MERGE( 2, 0, bc_dirichlet_l),                        &
     479                          .TRUE. )   
     480
     481       IF ( .NOT. neutral )  THEN
     482          CALL get_variable( pids_id, 'ls_forcing_left_pt',                    &
     483                             nest_offl%pt_left,                                &
     484                             MERGE( nys+1, 1, bc_dirichlet_l),                 &
     485                             MERGE( nzb+1, 1, bc_dirichlet_l),                 &
     486                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),      &
     487                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),             &
     488                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),         &
     489                             MERGE( 2, 0, bc_dirichlet_l),                     &
     490                             .TRUE. )
     491       ENDIF
     492
     493       IF ( humidity )  THEN
     494          CALL get_variable( pids_id, 'ls_forcing_left_qv',                    &
     495                             nest_offl%q_left,                                 &
     496                             MERGE( nys+1, 1, bc_dirichlet_l),                 &
     497                             MERGE( nzb+1, 1, bc_dirichlet_l),                 &
     498                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),      &
     499                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),             &
     500                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),         &
     501                             MERGE( 2, 0, bc_dirichlet_l),                     &
     502                             .TRUE. )
     503       ENDIF
     504       
     505       IF ( air_chemistry )  THEN
     506          DO  n = 1, UBOUND(nest_offl%var_names_chem_l, 1)
     507             IF ( check_existence( nest_offl%var_names,                        &
     508                                   nest_offl%var_names_chem_l(n) ) )  THEN 
     509                CALL get_variable( pids_id,                                    &
     510                           TRIM( nest_offl%var_names_chem_l(n) ),              &
     511                           nest_offl%chem_left(:,:,:,n),                       &
     512                           MERGE( nys+1, 1, bc_dirichlet_l),                   &
     513                           MERGE( nzb+1, 1, bc_dirichlet_l),                   &
     514                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),        &
     515                           MERGE( nyn-nys+1, 0, bc_dirichlet_l),               &
     516                           MERGE( nest_offl%nzu, 0, bc_dirichlet_l),           &
     517                           MERGE( 2, 0, bc_dirichlet_l),                       &
     518                           .TRUE. )
     519                nest_offl%chem_from_file_l(n) = .TRUE.
     520             ENDIF
     521          ENDDO
     522       ENDIF
     523!
     524!--    Read data for eastern boundary   
     525       CALL get_variable( pids_id, 'ls_forcing_right_u',                       &
     526                          nest_offl%u_right,                                   &
     527                          MERGE( nys+1, 1, bc_dirichlet_r),                    &
     528                          MERGE( nzb+1, 1, bc_dirichlet_r),                    &
     529                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
     530                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                &
     531                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),            &
     532                          MERGE( 2, 0, bc_dirichlet_r),                        &
     533                          .TRUE. )                                             
     534     
     535       CALL get_variable( pids_id, 'ls_forcing_right_v',                       &
     536                          nest_offl%v_right,                                   &
     537                          MERGE( nysv, 1, bc_dirichlet_r),                     &
     538                          MERGE( nzb+1, 1, bc_dirichlet_r),                    &
     539                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
     540                          MERGE( nyn-nysv+1, 0, bc_dirichlet_r),               &
     541                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),            &
     542                          MERGE( 2, 0, bc_dirichlet_r),                        &
     543                          .TRUE. )                                             
     544
     545       CALL get_variable( pids_id, 'ls_forcing_right_w',                       &
     546                          nest_offl%w_right,                                   &
     547                          MERGE( nys+1, 1, bc_dirichlet_r),                    &
     548                          MERGE( nzb+1, 1, bc_dirichlet_r),                    &
     549                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
     550                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                &
     551                          MERGE( nest_offl%nzw, 0, bc_dirichlet_r),            &
     552                          MERGE( 2, 0, bc_dirichlet_r),                        &
     553                          .TRUE. )   
     554
     555       IF ( .NOT. neutral )  THEN
     556          CALL get_variable( pids_id, 'ls_forcing_right_pt',                   &
     557                             nest_offl%pt_right,                               &
     558                             MERGE( nys+1, 1, bc_dirichlet_r),                 &
     559                             MERGE( nzb+1, 1, bc_dirichlet_r),                 &
     560                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),      &
     561                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),             &
     562                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),         &
     563                             MERGE( 2, 0, bc_dirichlet_r),                     &
     564                             .TRUE. )
     565       ENDIF
     566
     567       IF ( humidity )  THEN
     568          CALL get_variable( pids_id, 'ls_forcing_right_qv',                   &
     569                             nest_offl%q_right,                                &
     570                             MERGE( nys+1, 1, bc_dirichlet_r),                 &
     571                             MERGE( nzb+1, 1, bc_dirichlet_r),                 &
     572                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),      &
     573                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),             &
     574                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),         &
     575                             MERGE( 2, 0, bc_dirichlet_r),                     &
     576                             .TRUE. )
     577       ENDIF
     578       
     579       IF ( air_chemistry )  THEN
     580          DO  n = 1, UBOUND(nest_offl%var_names_chem_r, 1)
     581             IF ( check_existence( nest_offl%var_names,                        &
     582                                   nest_offl%var_names_chem_r(n) ) )  THEN     
     583                CALL get_variable( pids_id,                                    &
     584                           TRIM( nest_offl%var_names_chem_r(n) ),              &
     585                           nest_offl%chem_right(:,:,:,n),                      &
     586                           MERGE( nys+1, 1, bc_dirichlet_r),                   &
     587                           MERGE( nzb+1, 1, bc_dirichlet_r),                   &
     588                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),        &
     589                           MERGE( nyn-nys+1, 0, bc_dirichlet_r),               &
     590                           MERGE( nest_offl%nzu, 0, bc_dirichlet_r),           &
     591                           MERGE( 2, 0, bc_dirichlet_r),                       &
     592                           .TRUE. )
     593                nest_offl%chem_from_file_r(n) = .TRUE.
     594             ENDIF
     595          ENDDO
     596       ENDIF
     597!
     598!--    Read data for northern boundary
     599       CALL get_variable( pids_id, 'ls_forcing_north_u',                       & ! array to be read
     600                          nest_offl%u_north,                                   & ! start index x direction
     601                          MERGE( nxlu, 1, bc_dirichlet_n ),                    & ! start index z direction
     602                          MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
     603                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
     604                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_n ),              & ! number of elements alogn z
     605                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
     606                          MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
     607                          .TRUE. )                                             
     608                                                                               
     609       CALL get_variable( pids_id, 'ls_forcing_north_v',                       & ! array to be read
     610                          nest_offl%v_north,                                   & ! start index x direction
     611                          MERGE( nxl+1, 1, bc_dirichlet_n ),                   & ! start index z direction
     612                          MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
     613                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
     614                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),               & ! number of elements alogn z
     615                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
     616                          MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
     617                          .TRUE. )                                             
     618                                                                               
     619       CALL get_variable( pids_id, 'ls_forcing_north_w',                       & ! array to be read
     620                          nest_offl%w_north,                                   & ! start index x direction
     621                          MERGE( nxl+1, 1, bc_dirichlet_n ),                   & ! start index z direction
     622                          MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
     623                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
     624                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),               & ! number of elements alogn z
     625                          MERGE( nest_offl%nzw, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
     626                          MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
     627                          .TRUE. )                                             
     628                                                                               
     629       IF ( .NOT. neutral )  THEN                                             
     630          CALL get_variable( pids_id, 'ls_forcing_north_pt',                   & ! array to be read
     631                             nest_offl%pt_north,                               & ! start index x direction
     632                             MERGE( nxl+1, 1, bc_dirichlet_n ),                & ! start index z direction
     633                             MERGE( nzb+1, 1, bc_dirichlet_n ),                & ! start index time dimension
     634                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),     & ! number of elements along x
     635                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),            & ! number of elements alogn z
     636                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),        & ! number of time steps (2 or 0)
     637                             MERGE( 2, 0, bc_dirichlet_n ),                    & ! parallel IO when compiled accordingly
     638                             .TRUE. )                                             
     639       ENDIF                                                                   
     640       IF ( humidity )  THEN                                                   
     641          CALL get_variable( pids_id, 'ls_forcing_north_qv',                   & ! array to be read
     642                             nest_offl%q_north,                                & ! start index x direction
     643                             MERGE( nxl+1, 1, bc_dirichlet_n ),                & ! start index z direction
     644                             MERGE( nzb+1, 1, bc_dirichlet_n ),                & ! start index time dimension
     645                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),     & ! number of elements along x
     646                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),            & ! number of elements alogn z
     647                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),        & ! number of time steps (2 or 0)
     648                             MERGE( 2, 0, bc_dirichlet_n ),                    & ! parallel IO when compiled accordingly
     649                             .TRUE. )                                             
     650       ENDIF                                                                   
     651                                                                               
     652       IF ( air_chemistry )  THEN                                             
     653          DO  n = 1, UBOUND(nest_offl%var_names_chem_n, 1)                     
     654             IF ( check_existence( nest_offl%var_names,                        &
     655                                   nest_offl%var_names_chem_n(n) ) )  THEN     
     656                CALL get_variable( pids_id,                                    &
     657                           TRIM( nest_offl%var_names_chem_n(n) ),              &
     658                           nest_offl%chem_north(:,:,:,n),                      &
     659                           MERGE( nxl+1, 1, bc_dirichlet_n ),                  &
     660                           MERGE( nzb+1, 1, bc_dirichlet_n ),                  &
     661                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),       &
     662                           MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),              &
     663                           MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),          &
     664                           MERGE( 2, 0, bc_dirichlet_n ),                      &
     665                           .TRUE. )
     666                nest_offl%chem_from_file_n(n) = .TRUE.
     667             ENDIF
     668          ENDDO
     669       ENDIF
     670!
     671!--    Read data for southern boundary
     672       CALL get_variable( pids_id, 'ls_forcing_south_u',                       & ! array to be read
     673                          nest_offl%u_south,                                   & ! start index x direction
     674                          MERGE( nxlu, 1, bc_dirichlet_s ),                    & ! start index z direction
     675                          MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
     676                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
     677                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_s ),              & ! number of elements alogn z
     678                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
     679                          MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
     680                          .TRUE. )                                             
     681                                                                               
     682       CALL get_variable( pids_id, 'ls_forcing_south_v',                       & ! array to be read
     683                          nest_offl%v_south,                                   & ! start index x direction
     684                          MERGE( nxl+1, 1, bc_dirichlet_s ),                   & ! start index z direction
     685                          MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
     686                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
     687                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),               & ! number of elements alogn z
     688                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
     689                          MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
     690                          .TRUE. )                                             
     691                                                                               
     692       CALL get_variable( pids_id, 'ls_forcing_south_w',                       & ! array to be read
     693                          nest_offl%w_south,                                   & ! start index x direction
     694                          MERGE( nxl+1, 1, bc_dirichlet_s ),                   & ! start index z direction
     695                          MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
     696                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
     697                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),               & ! number of elements alogn z
     698                          MERGE( nest_offl%nzw, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
     699                          MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
     700                          .TRUE. )                                             
     701                                                                               
     702       IF ( .NOT. neutral )  THEN                                             
     703          CALL get_variable( pids_id, 'ls_forcing_south_pt',                   & ! array to be read
     704                             nest_offl%pt_south,                               & ! start index x direction
     705                             MERGE( nxl+1, 1, bc_dirichlet_s ),                & ! start index z direction
     706                             MERGE( nzb+1, 1, bc_dirichlet_s ),                & ! start index time dimension
     707                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),     & ! number of elements along x
     708                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),            & ! number of elements alogn z
     709                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),        & ! number of time steps (2 or 0)
     710                             MERGE( 2, 0, bc_dirichlet_s ),                    & ! parallel IO when compiled accordingly
     711                             .TRUE. )                                             
     712       ENDIF                                                                   
     713       IF ( humidity )  THEN                                                   
     714          CALL get_variable( pids_id, 'ls_forcing_south_qv',                   & ! array to be read
     715                             nest_offl%q_south,                                & ! start index x direction
     716                             MERGE( nxl+1, 1, bc_dirichlet_s ),                & ! start index z direction
     717                             MERGE( nzb+1, 1, bc_dirichlet_s ),                & ! start index time dimension
     718                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),     & ! number of elements along x
     719                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),            & ! number of elements alogn z
     720                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),        & ! number of time steps (2 or 0)
     721                             MERGE( 2, 0, bc_dirichlet_s ),                    & ! parallel IO when compiled accordingly
     722                             .TRUE. )                                             
     723       ENDIF                                                                   
     724                                                                               
     725       IF ( air_chemistry )  THEN                                             
     726          DO  n = 1, UBOUND(nest_offl%var_names_chem_s, 1)                     
     727             IF ( check_existence( nest_offl%var_names,                        &
     728                                   nest_offl%var_names_chem_s(n) ) )  THEN     
     729                CALL get_variable( pids_id,                                    &
     730                           TRIM( nest_offl%var_names_chem_s(n) ),              &
     731                           nest_offl%chem_south(:,:,:,n),                      &
     732                           MERGE( nxl+1, 1, bc_dirichlet_s ),                  &
     733                           MERGE( nzb+1, 1, bc_dirichlet_s ),                  &
     734                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),       &
     735                           MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),              &
     736                           MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),          &
     737                           MERGE( 2, 0, bc_dirichlet_s ),                      &
     738                           .TRUE. )
     739                nest_offl%chem_from_file_s(n) = .TRUE.
     740             ENDIF
     741          ENDDO
     742       ENDIF
     743!
     744!--    Top boundary
     745       CALL get_variable( pids_id, 'ls_forcing_top_u',                         &
     746                             nest_offl%u_top(0:1,nys:nyn,nxlu:nxr),            &
     747                             nxlu, nys+1, nest_offl%tind+1,                    &
     748                             nxr-nxlu+1, nyn-nys+1, 2, .TRUE. )
     749
     750       CALL get_variable( pids_id, 'ls_forcing_top_v',                         &
     751                             nest_offl%v_top(0:1,nysv:nyn,nxl:nxr),            &
     752                             nxl+1, nysv, nest_offl%tind+1,                    &
     753                             nxr-nxl+1, nyn-nysv+1, 2, .TRUE. )
     754                             
     755       CALL get_variable( pids_id, 'ls_forcing_top_w',                         &
     756                             nest_offl%w_top(0:1,nys:nyn,nxl:nxr),             &
     757                             nxl+1, nys+1, nest_offl%tind+1,                   &
     758                             nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
     759                             
     760       IF ( .NOT. neutral )  THEN
     761          CALL get_variable( pids_id, 'ls_forcing_top_pt',                     &
     762                                nest_offl%pt_top(0:1,nys:nyn,nxl:nxr),         &
     763                                nxl+1, nys+1, nest_offl%tind+1,                &
     764                                nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
     765       ENDIF
     766       IF ( humidity )  THEN
     767          CALL get_variable( pids_id, 'ls_forcing_top_qv',                     &
     768                                nest_offl%q_top(0:1,nys:nyn,nxl:nxr),          &
     769                                nxl+1, nys+1, nest_offl%tind+1,                &
     770                                nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
     771       ENDIF
     772       
     773       IF ( air_chemistry )  THEN
     774          DO  n = 1, UBOUND(nest_offl%var_names_chem_t, 1)
     775             IF ( check_existence( nest_offl%var_names,                        &
     776                                   nest_offl%var_names_chem_t(n) ) )  THEN     
     777                CALL get_variable( pids_id,                                    &
     778                              TRIM( nest_offl%var_names_chem_t(n) ),           &
     779                              nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,n),       &
     780                              nxl+1, nys+1, nest_offl%tind+1,                  &
     781                              nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
     782                nest_offl%chem_from_file_t(n) = .TRUE.
     783             ENDIF
     784          ENDDO
     785       ENDIF
     786
     787!
     788!--    Close input file
     789       CALL close_input_file( pids_id )
     790#endif
     791!
     792!--    Set control flag to indicate that boundary data has been initially
     793!--    input.
     794       nest_offl%init = .TRUE.
     795!
     796!--    End of CPU measurement
     797       CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'stop' )
     798
     799    END SUBROUTINE nesting_offl_input
     800
    199801
    200802!------------------------------------------------------------------------------!
     
    210812    SUBROUTINE nesting_offl_mass_conservation
    211813
    212        IMPLICIT NONE
    213 
    214814       INTEGER(iwp) ::  i !< grid index in x-direction
    215815       INTEGER(iwp) ::  j !< grid index in y-direction
     
    281881#if defined( __parallel )
    282882       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    283        CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM,      &
     883       CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM,   &
    284884                           comm2d, ierr )
    285885#else
     
    314914    SUBROUTINE nesting_offl_bc                     
    315915
    316        IMPLICIT NONE
    317 
    318916       INTEGER(iwp) ::  i !< running index x-direction
    319917       INTEGER(iwp) ::  j !< running index y-direction
    320918       INTEGER(iwp) ::  k !< running index z-direction
    321919       INTEGER(iwp) ::  n !< running index for chemical species
    322 
    323        REAL(wp) ::  fac_dt   !< interpolation factor
    324920       
    325921       REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_ref   !< reference profile for potential temperature
     
    347943       u_ref_l  = 0.0_wp
    348944       v_ref_l  = 0.0_wp
    349 !
    350 !--    Determine interpolation factor and limit it to 1. This is because
    351 !--    t+dt can slightly exceed time(tind_p) before boundary data is updated
    352 !--    again.
    353        fac_dt = ( time_since_reference_point - nest_offl%time(nest_offl%tind)  &
    354                 + dt_3d ) /                                                    &
    355            ( nest_offl%time(nest_offl%tind_p) - nest_offl%time(nest_offl%tind) )
    356        fac_dt = MIN( 1.0_wp, fac_dt )
    357945!
    358946!--    Set boundary conditions of u-, v-, w-component, as well as q, and pt.
     
    8631451       CALL nesting_offl_calc_zi
    8641452       CALL adjust_sponge_layer
    865    
     1453       
     1454       CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
     1455
     1456       IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'end' )
     1457
     1458
     1459    END SUBROUTINE nesting_offl_bc
     1460
     1461!------------------------------------------------------------------------------!
     1462! Description:
     1463!------------------------------------------------------------------------------!
     1464!>  Update of the geostrophic wind components.
     1465!>  @todo: update geostrophic wind also in the child domains (should be done
     1466!>         in the nesting.
     1467!------------------------------------------------------------------------------!
     1468    SUBROUTINE nesting_offl_geostrophic_wind
     1469
     1470       INTEGER(iwp) ::  k
    8661471!
    8671472!--    Update geostrophic wind components from dynamic input file.
     
    8741479       ug(nzt+1) = ug(nzt)
    8751480       vg(nzt+1) = vg(nzt)
    876    
    877        CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
    878 
    879        IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'end' )
    880 
    881 
    882     END SUBROUTINE nesting_offl_bc
     1481
     1482    END SUBROUTINE nesting_offl_geostrophic_wind
     1483
     1484!------------------------------------------------------------------------------!
     1485! Description:
     1486!------------------------------------------------------------------------------!
     1487!>  Determine the interpolation constant for time interpolation. The
     1488!>  calculation is separated from the nesting_offl_bc and
     1489!>  nesting_offl_geostrophic_wind in order to be independent on the order
     1490!>  of calls.
     1491!------------------------------------------------------------------------------!
     1492    SUBROUTINE nesting_offl_interpolation_factor
     1493!
     1494!--    Determine interpolation factor and limit it to 1. This is because
     1495!--    t+dt can slightly exceed time(tind_p) before boundary data is updated
     1496!--    again.
     1497       fac_dt = ( time_utc_init + time_since_reference_point                   &
     1498                - nest_offl%time(nest_offl%tind) + dt_3d ) /                   &
     1499           ( nest_offl%time(nest_offl%tind_p) - nest_offl%time(nest_offl%tind) )
     1500
     1501       fac_dt = MIN( 1.0_wp, fac_dt )
     1502
     1503    END SUBROUTINE nesting_offl_interpolation_factor
    8831504
    8841505!------------------------------------------------------------------------------!
     
    8891510!------------------------------------------------------------------------------!
    8901511    SUBROUTINE nesting_offl_calc_zi
    891        
    892        USE basic_constants_and_equations_mod,                                  &
    893            ONLY:  g
    894        
    895        USE kinds
    896 
    897        IMPLICIT NONE
    8981512
    8991513       INTEGER(iwp) :: i                            !< loop index in x-direction
     
    10701684!------------------------------------------------------------------------------!
    10711685    SUBROUTINE adjust_sponge_layer
    1072        
    1073        USE arrays_3d,                                                          &
    1074            ONLY:  rdf, rdf_sc, zu
    1075        
    1076        USE basic_constants_and_equations_mod,                                  &
    1077            ONLY:  pi
    1078        
    1079        USE kinds
    1080 
    1081        IMPLICIT NONE
    10821686
    10831687       INTEGER(iwp) :: k   !< loop index in z-direction
     
    11161720!------------------------------------------------------------------------------!
    11171721    SUBROUTINE nesting_offl_check_parameters
    1118 
    1119        IMPLICIT NONE
    11201722!
    11211723!--    Check if offline nesting is applied in nested child domain.
     
    11231725          message_string = 'Offline nesting is only applicable in root model.'
    11241726          CALL message( 'offline_nesting_check_parameters', 'PA0622', 1, 2, 0, 6, 0 )       
    1125        ENDIF     
     1727       ENDIF
    11261728
    11271729    END SUBROUTINE nesting_offl_check_parameters
     
    11331735!------------------------------------------------------------------------------!
    11341736    SUBROUTINE nesting_offl_parin
    1135 
    1136        IMPLICIT NONE
    11371737       
    11381738       CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line of the parameter file
     
    11741774    SUBROUTINE nesting_offl_header ( io )
    11751775
    1176        IMPLICIT NONE
    1177 
    11781776       INTEGER(iwp), INTENT(IN) ::  io !< Unit of the output file
    11791777
     
    11991797!------------------------------------------------------------------------------!
    12001798    SUBROUTINE nesting_offl_init
    1201    
    1202        USE netcdf_data_input_mod,                                              &
    1203            ONLY:  netcdf_data_input_offline_nesting 
    1204 
    1205        IMPLICIT NONE
    1206        
     1799           
    12071800       INTEGER(iwp) ::  n !< running index for chemical species
    12081801
     
    13401933       ENDIF
    13411934!
     1935!--    Before initial data input is initiated, check if dynamic input file is
     1936!--    present.
     1937       IF ( .NOT. input_pids_dynamic )  THEN
     1938          message_string = 'nesting_offline = .TRUE. requires dynamic '  //    &
     1939                            'input file ' //                                   &
     1940                            TRIM( input_file_dynamic ) // TRIM( coupling_char )
     1941          CALL message( 'nesting_offl_init', 'PA0546', 1, 2, 0, 6, 0 )
     1942       ENDIF
     1943!
    13421944!--    Read COSMO data at lateral and top boundaries
    1343        CALL netcdf_data_input_offline_nesting
     1945       CALL nesting_offl_input
    13441946!
    13451947!--    Check if sufficient time steps are provided to cover the entire
     
    13471949!--    not for the soil/wall spinup. However, as the spinup time is added
    13481950!--    to the end_time, this must be considered here.
    1349        IF ( end_time - spinup_time > nest_offl%time(nest_offl%nt-1) )  THEN
    1350           message_string = 'end_time > provided time in offline nesting.'
    1351           CALL message( 'offline_nesting_check_parameters', 'PA0183',          &
    1352                         1, 2, 0, 6, 0 )
     1951       IF ( end_time - spinup_time >                                           &
     1952            nest_offl%time(nest_offl%nt-1) - time_utc_init )  THEN
     1953          message_string = 'end_time of the simulation exceeds the ' //        &
     1954                           'time dimension in the dynamic input file.'
     1955          CALL message( 'nesting_offl_init', 'PA0183', 1, 2, 0, 6, 0 )
     1956       ENDIF
     1957
     1958       IF ( nest_offl%time(0) /= time_utc_init )  THEN
     1959          message_string = 'Offline nesting: time dimension must start at ' // &
     1960                           ' time_utc_init.'
     1961          CALL message( 'nesting_offl_init', 'PA0676', 1, 2, 0, 6, 0 )
    13531962       ENDIF
    13541963!
     
    14662075!------------------------------------------------------------------------------!
    14672076    FUNCTION interpolate_in_time( var_t1, var_t2, fac  )
    1468        
    1469        USE kinds
    1470 
    1471        IMPLICIT NONE
    14722077
    14732078       REAL(wp)            :: interpolate_in_time !< time-interpolated boundary value
  • palm/trunk/SOURCE/netcdf_data_input_mod.f90

    r4190 r4226  
    2525! -----------------
    2626! $Id$
     27! - Netcdf input routine for dimension length renamed
     28! - Move offline-nesting-specific checks to nesting_offl_mod
     29! - Module-specific input of boundary data for offline nesting moved to
     30!   nesting_offl_mod
     31! - Define module specific data type for offline nesting in nesting_offl_mod
     32!
     33! 4190 2019-08-27 15:42:37Z suehring
    2734! type real_1d changed to real_1d_3d
    2835!
     
    169176       REAL(wp), DIMENSION(:), ALLOCATABLE :: z       !< dimension array in z
    170177    END TYPE dims_xy
    171 !
    172 !-- Define data type for nesting in larger-scale models like COSMO.
    173 !-- Data type comprises u, v, w, pt, and q at lateral and top boundaries.
    174     TYPE nest_offl_type
    175 
    176        CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'  !< leading substring for variables at left boundary
    177        CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_' !< leading substring for variables at north boundary 
    178        CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_' !< leading substring for variables at right boundary 
    179        CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_' !< leading substring for variables at south boundary
    180        CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'   !< leading substring for variables at top boundary
    181 
    182        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names         !< list of variable in dynamic input file
    183        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_l  !< names of mesoscale nested chemistry variables at left boundary
    184        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_n  !< names of mesoscale nested chemistry variables at north boundary
    185        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_r  !< names of mesoscale nested chemistry variables at right boundary
    186        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_s  !< names of mesoscale nested chemistry variables at south boundary
    187        CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_t  !< names of mesoscale nested chemistry variables at top boundary
    188 
    189        INTEGER(iwp) ::  nt     !< number of time levels in dynamic input file
    190        INTEGER(iwp) ::  nzu    !< number of vertical levels on scalar grid in dynamic input file
    191        INTEGER(iwp) ::  nzw    !< number of vertical levels on w grid in dynamic input file
    192        INTEGER(iwp) ::  tind   !< time index for reference time in mesoscale-offline nesting
    193        INTEGER(iwp) ::  tind_p !< time index for following time in mesoscale-offline nesting
    194 
    195        LOGICAL      ::  init         = .FALSE. !< flag indicating that offline nesting is already initialized
    196 
    197        LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_l !< flags inidicating whether left boundary data for chemistry is in dynamic input file 
    198        LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_n !< flags inidicating whether north boundary data for chemistry is in dynamic input file
    199        LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_r !< flags inidicating whether right boundary data for chemistry is in dynamic input file
    200        LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_s !< flags inidicating whether south boundary data for chemistry is in dynamic input file
    201        LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_t !< flags inidicating whether top boundary data for chemistry is in dynamic input file
    202 
    203        REAL(wp), DIMENSION(:), ALLOCATABLE ::  surface_pressure !< time dependent surface pressure
    204        REAL(wp), DIMENSION(:), ALLOCATABLE ::  time             !< time levels in dynamic input file
    205        REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos         !< vertical levels at scalar grid in dynamic input file
    206        REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos         !< vertical levels at w grid in dynamic input file
    207 
    208        REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug         !< domain-averaged geostrophic component
    209        REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg         !< domain-averaged geostrophic component
    210 
    211        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_left   !< u-component at left boundary
    212        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_left   !< v-component at left boundary
    213        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_left   !< w-component at left boundary
    214        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_left   !< mixing ratio at left boundary
    215        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_left  !< potentital temperautre at left boundary
    216 
    217        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_north  !< u-component at north boundary
    218        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_north  !< v-component at north boundary
    219        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_north  !< w-component at north boundary
    220        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_north  !< mixing ratio at north boundary
    221        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_north !< potentital temperautre at north boundary
    222 
    223        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_right  !< u-component at right boundary
    224        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_right  !< v-component at right boundary
    225        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_right  !< w-component at right boundary
    226        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_right  !< mixing ratio at right boundary
    227        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_right !< potentital temperautre at right boundary
    228 
    229        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_south  !< u-component at south boundary
    230        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_south  !< v-component at south boundary
    231        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_south  !< w-component at south boundary
    232        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_south  !< mixing ratio at south boundary
    233        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_south !< potentital temperautre at south boundary
    234 
    235        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
    236        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
    237        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
    238        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
    239        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
    240        
    241        REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_left   !< chemical species at left boundary
    242        REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_north  !< chemical species at left boundary
    243        REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_right  !< chemical species at left boundary
    244        REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_south  !< chemical species at left boundary
    245        REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_top    !< chemical species at left boundary
    246 
    247     END TYPE nest_offl_type
    248 
    249178    TYPE init_type
    250179
     
    571500    TYPE(crs_type)   ::  coord_ref_sys  !< coordinate reference system
    572501
    573     TYPE(dims_xy)    ::  dim_static     !< data structure for x, y-dimension in static input file
    574 
    575     TYPE(nest_offl_type) ::  nest_offl  !< data structure for data input at lateral and top boundaries (provided by Inifor) 
     502    TYPE(dims_xy)    ::  dim_static     !< data structure for x, y-dimension in static input file
    576503
    577504    TYPE(init_type) ::  init_3d    !< data structure for the initialization of the 3D flow and soil fields
     
    679606    END INTERFACE netcdf_data_input_chemistry_data
    680607   
    681     INTERFACE netcdf_data_input_get_dimension_length                       
    682        MODULE PROCEDURE netcdf_data_input_get_dimension_length
    683     END INTERFACE netcdf_data_input_get_dimension_length
     608    INTERFACE get_dimension_length                       
     609       MODULE PROCEDURE get_dimension_length
     610    END INTERFACE get_dimension_length
    684611
    685612    INTERFACE netcdf_data_input_inquire_file
     
    705632       MODULE PROCEDURE netcdf_data_input_init_lsm
    706633    END INTERFACE netcdf_data_input_init_lsm
    707 
    708     INTERFACE netcdf_data_input_offline_nesting
    709        MODULE PROCEDURE netcdf_data_input_offline_nesting
    710     END INTERFACE netcdf_data_input_offline_nesting
    711634
    712635    INTERFACE netcdf_data_input_surface_data
     
    770693           input_pids_static,                                                  &
    771694           input_pids_dynamic, input_pids_vm, input_file_vm,                   &
    772            leaf_area_density_f, nest_offl,                                     &
     695           leaf_area_density_f,                                                &
    773696           num_var_pids,                                                       &
    774697           pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f,       &
     
    790713    PUBLIC netcdf_data_input_check_dynamic, netcdf_data_input_check_static,    &
    791714           netcdf_data_input_chemistry_data,                                   &
    792            netcdf_data_input_get_dimension_length,                             &
     715           get_dimension_length,                                               &
    793716           netcdf_data_input_inquire_file,                                     &
    794717           netcdf_data_input_init, netcdf_data_input_init_lsm,                 &
    795718           netcdf_data_input_init_3d, netcdf_data_input_att,                   &
    796            netcdf_data_input_interpolate, netcdf_data_input_offline_nesting,   &
     719           netcdf_data_input_interpolate,                                      &
    797720           netcdf_data_input_surface_data, netcdf_data_input_topo,             &
    798            netcdf_data_input_var, get_attribute, get_variable, open_read_file, &
    799            check_existence, inquire_num_variables, inquire_variable_names,     &
     721           netcdf_data_input_var,                                              &
     722           get_attribute,                                                      &
     723           get_variable,                                                       &
     724           get_variable_pr,                                                    &
     725           open_read_file,                                                     &
     726           check_existence,                                                    &
     727           inquire_num_variables,                                              &
     728           inquire_variable_names,                                             &
    800729           close_input_file
    801730
     
    13471276!-- Tther dimensions depend on the emission mode or specific components
    13481277
    1349           CALL netcdf_data_input_get_dimension_length (    &
    1350                                  id_emis, emt_att%n_emiss_species, 'nspecies' )
     1278          CALL get_dimension_length ( id_emis, emt_att%n_emiss_species, 'nspecies' )
    13511279
    13521280!
     
    14081336!-- get number of emission categories
    14091337
    1410              CALL netcdf_data_input_get_dimension_length (           &
    1411                                     id_emis, emt_att%ncat, 'ncat' )
     1338             CALL get_dimension_length ( id_emis, emt_att%ncat, 'ncat' )
    14121339
    14131340!-- READING IN EMISSION CATEGORIES INDICES
     
    14451372!
    14461373!-- VOC name
    1447                    CALL netcdf_data_input_get_dimension_length (     &
    1448                                           id_emis, emt_att%nvoc, 'nvoc' )
     1374                   CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' )
    14491375                   ALLOCATE ( emt_att%voc_name(emt_att%nvoc) )
    14501376                   CALL get_variable ( id_emis,"emission_voc_name",  &
     
    14711397!-- PM name
    14721398
    1473                    CALL netcdf_data_input_get_dimension_length (     &
    1474                                           id_emis, emt_att%npm, 'npm' )
     1399                   CALL get_dimension_length ( id_emis, emt_att%npm, 'npm' )
    14751400                   ALLOCATE ( emt_att%pm_name(emt_att%npm) )
    14761401                   CALL get_variable ( id_emis, "pm_name", string_values, emt_att%npm )
     
    15221447                   TRIM(time_fac_type) == "hour" )  THEN
    15231448
    1524                 CALL netcdf_data_input_get_dimension_length (                  &
    1525                                        id_emis, emt_att%nhoursyear, 'nhoursyear' )
     1449                CALL get_dimension_length ( id_emis, emt_att%nhoursyear, 'nhoursyear' )
    15261450                ALLOCATE ( emt_att%hourly_emis_time_factor(emt_att%ncat,emt_att%nhoursyear) )
    15271451                CALL get_variable ( id_emis, "emission_time_factors",          &
     
    15351459                        TRIM(time_fac_type)  ==  "mdh" )  THEN
    15361460
    1537                 CALL netcdf_data_input_get_dimension_length (                  &
    1538                                        id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' )
     1461                CALL get_dimension_length ( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' )
    15391462                ALLOCATE ( emt_att%mdh_emis_time_factor(emt_att%ncat,emt_att%nmonthdayhour) )
    15401463                CALL get_variable ( id_emis, "emission_time_factors",          &
     
    16521575!
    16531576!-- VOC name
    1654                    CALL netcdf_data_input_get_dimension_length (                         &
    1655                                           id_emis, emt_att%nvoc, 'nvoc' )
     1577                   CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' )
    16561578                   ALLOCATE ( emt_att%voc_name(emt_att%nvoc) )
    16571579                   CALL get_variable ( id_emis, "emission_voc_name",                     &
     
    16731595!-- EMISSION DATA
    16741596
    1675              CALL netcdf_data_input_get_dimension_length (                               &
    1676                                     id_emis, emt_att%dt_emission, 'time' )   
     1597             CALL get_dimension_length ( id_emis, emt_att%dt_emission, 'time' )   
    16771598 
    16781599!
     
    18051726!
    18061727!--          Inquire number of vertical vegetation layer
    1807              CALL netcdf_data_input_get_dimension_length( id_surf,             &
    1808                                                  leaf_area_density_f%nz,       &
    1809                                                  'zlad' )
     1728             CALL get_dimension_length( id_surf,                               &
     1729                                        leaf_area_density_f%nz,                &
     1730                                        'zlad' )
    18101731!
    18111732!--          Allocate variable for leaf-area density
     
    18301751!
    18311752!--          Inquire number of vertical vegetation layer
    1832              CALL netcdf_data_input_get_dimension_length( id_surf,             &
    1833                                                  basal_area_density_f%nz,      &
    1834                                                  'zlad' )
     1753             CALL get_dimension_length( id_surf,                               &
     1754                                        basal_area_density_f%nz,               &
     1755                                        'zlad' )
    18351756!
    18361757!--          Allocate variable
     
    18541775!
    18551776!--          Inquire number of vertical soil layers
    1856              CALL netcdf_data_input_get_dimension_length( id_surf,             &
     1777             CALL get_dimension_length( id_surf,             &
    18571778                                                   root_area_density_lad_f%nz, &
    18581779                                                  'zsoil' )
     
    19361857!
    19371858!--          Obtain number of soil layers from file.
    1938              CALL netcdf_data_input_get_dimension_length( id_surf, nz_soil,    &
    1939                                                           'zsoil' )
     1859             CALL get_dimension_length( id_surf, nz_soil, 'zsoil' )
    19401860
    19411861             ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) )
     
    19891909!
    19901910!--       Inquire number of surface fractions
    1991           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    1992                                                        surface_fraction_f%nf,  &
    1993                                                        'nsurface_fraction' )
     1911          CALL get_dimension_length( id_surf,                                  &
     1912                                     surface_fraction_f%nf,                    &
     1913                                     'nsurface_fraction' )
    19941914!
    19951915!--       Allocate dimension array and input array for surface fractions
     
    20181938!
    20191939!--       Inquire number of building parameters
    2020           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2021                                                        building_pars_f%np,     &
    2022                                                        'nbuilding_pars' )
     1940          CALL get_dimension_length( id_surf,                                  &
     1941                                      building_pars_f%np,                      &
     1942                                      'nbuilding_pars' )
    20231943!
    20241944!--       Allocate dimension array and input array for building parameters
     
    20611981!
    20621982!--       Inquire number of albedo parameters
    2063           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2064                                                        albedo_pars_f%np,       &
    2065                                                        'nalbedo_pars' )
     1983          CALL get_dimension_length( id_surf,                                  &
     1984                                     albedo_pars_f%np,                         &
     1985                                     'nalbedo_pars' )
    20661986!
    20671987!--       Allocate dimension array and input array for albedo parameters
     
    20892009!
    20902010!--       Inquire number of pavement parameters
    2091           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2092                                                        pavement_pars_f%np,     &
    2093                                                        'npavement_pars' )
     2011          CALL get_dimension_length( id_surf,                                  &
     2012                                     pavement_pars_f%np,                       &
     2013                                     'npavement_pars' )
    20942014!
    20952015!--       Allocate dimension array and input array for pavement parameters
     
    21182038!
    21192039!--       Inquire number of parameters
    2120           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2121                                                 pavement_subsurface_pars_f%np, &
    2122                                                'npavement_subsurface_pars' )
     2040          CALL get_dimension_length( id_surf,                                  &
     2041                                     pavement_subsurface_pars_f%np,            &
     2042                                     'npavement_subsurface_pars' )
    21232043!
    21242044!--       Inquire number of soil layers
    2125           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2126                                                 pavement_subsurface_pars_f%nz, &
    2127                                                 'zsoil' )
     2045          CALL get_dimension_length( id_surf,                                  &
     2046                                     pavement_subsurface_pars_f%nz,            &
     2047                                     'zsoil' )
    21282048!
    21292049!--       Allocate dimension array and input array for pavement parameters
     
    21582078!
    21592079!--       Inquire number of vegetation parameters
    2160           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2161                                                        vegetation_pars_f%np,   &
    2162                                                        'nvegetation_pars' )
     2080          CALL get_dimension_length( id_surf,                                  &
     2081                                     vegetation_pars_f%np,                     &
     2082                                     'nvegetation_pars' )
    21632083!
    21642084!--       Allocate dimension array and input array for surface fractions
     
    21922112!
    21932113!--       Inquire number of soil parameters
    2194           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2195                                                        soil_pars_f%np,         &
    2196                                                        'nsoil_pars' )
     2114          CALL get_dimension_length( id_surf,                                  &
     2115                                     soil_pars_f%np,                           &
     2116                                     'nsoil_pars' )
    21972117!
    21982118!--       Read parameters array
     
    22042124!--       soil layers, allocate memory and read the respective dimension
    22052125          IF ( soil_pars_f%lod == 2 )  THEN
    2206              CALL netcdf_data_input_get_dimension_length( id_surf,             &
    2207                                                           soil_pars_f%nz,      &
    2208                                                           'zsoil' )
     2126             CALL get_dimension_length( id_surf,                               &
     2127                                        soil_pars_f%nz,                        &
     2128                                        'zsoil' )
    22092129
    22102130             ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) )
     
    22452165!
    22462166!--       Inquire number of water parameters
    2247           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2248                                                        water_pars_f%np,        &
    2249                                                        'nwater_pars' )
     2167          CALL get_dimension_length( id_surf,                                  &
     2168                                     water_pars_f%np,                          &
     2169                                     'nwater_pars' )
    22502170!
    22512171!--       Allocate dimension array and input array for water parameters
     
    22712191!
    22722192!--       Obtain number of soil layers from file and allocate variable
    2273           CALL netcdf_data_input_get_dimension_length( id_surf,                &
    2274                                                    root_area_density_lsm_f%nz, &
    2275                                                    'zsoil' )
     2193          CALL get_dimension_length( id_surf,                                  &
     2194                                     root_area_density_lsm_f%nz,              &
     2195                                     'zsoil' )
    22762196          ALLOCATE( root_area_density_lsm_f%var                                &
    22772197                                        (0:root_area_density_lsm_f%nz-1,       &
     
    26452565!
    26462566!--       Read x, y - dimensions. Only required for consistency checks.
    2647           CALL netcdf_data_input_get_dimension_length( id_topo, dim_static%nx, 'x' )
    2648           CALL netcdf_data_input_get_dimension_length( id_topo, dim_static%ny, 'y' )
     2567          CALL get_dimension_length( id_topo, dim_static%nx, 'x' )
     2568          CALL get_dimension_length( id_topo, dim_static%ny, 'y' )
    26492569          ALLOCATE( dim_static%x(0:dim_static%nx-1) )
    26502570          ALLOCATE( dim_static%y(0:dim_static%ny-1) )
     
    27252645                                 .FALSE., 'buildings_3d' )
    27262646
    2727              CALL netcdf_data_input_get_dimension_length( id_topo,             &
    2728                                                           buildings_f%nz, 'z' )
     2647             CALL get_dimension_length( id_topo, buildings_f%nz, 'z' )
    27292648!
    27302649!--          Read 3D buildings
     
    29412860!
    29422861!--    Read vertical dimension of scalar und w grid.
    2943        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nzu, 'z'     )
    2944        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nzw, 'zw'    )
     2862       CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z'     )
     2863       CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw'    )
    29452864!
    29462865!--    Read also the horizontal dimensions. These are used just used fo
    29472866!--    checking the compatibility with the PALM grid before reading.
    2948        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nx,  'x'  )
    2949        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nxu, 'xu' )
    2950        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%ny,  'y'  )
    2951        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nyv, 'yv' )
     2867       CALL get_dimension_length( id_dynamic, init_3d%nx,  'x'  )
     2868       CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' )
     2869       CALL get_dimension_length( id_dynamic, init_3d%ny,  'y'  )
     2870       CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' )
    29522871
    29532872!
     
    34443363!--    Read vertical dimension for soil depth.
    34453364       IF ( check_existence( var_names, 'zsoil' ) )                            &
    3446           CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nzs,&
    3447                                                        'zsoil' )
     3365          CALL get_dimension_length( id_dynamic, init_3d%nzs, 'zsoil' )
    34483366!
    34493367!--    Read also the horizontal dimensions required for soil initialization.
     
    34513369!--    these data is already available, but will be read again for the sake
    34523370!--    of clearness.
    3453        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%nx,    &
    3454                                                     'x'  )
    3455        CALL netcdf_data_input_get_dimension_length( id_dynamic, init_3d%ny,    &
    3456                                                     'y'  )
     3371       CALL get_dimension_length( id_dynamic, init_3d%nx, 'x'  )
     3372       CALL get_dimension_length( id_dynamic, init_3d%ny, 'y'  )
    34573373!
    34583374!--    Check for correct horizontal and vertical dimension. Please note,
     
    35443460! Description:
    35453461! ------------
    3546 !> Reads data at lateral and top boundaries derived from larger-scale model
    3547 !> (COSMO) by Inifor.
    3548 !------------------------------------------------------------------------------!
    3549     SUBROUTINE netcdf_data_input_offline_nesting
     3462!> Checks input file for consistency and minimum requirements.
     3463!------------------------------------------------------------------------------!
     3464    SUBROUTINE netcdf_data_input_check_dynamic
    35503465
    35513466       USE control_parameters,                                                 &
    3552            ONLY:  air_chemistry, bc_dirichlet_l, bc_dirichlet_n,               &
    3553                   bc_dirichlet_r, bc_dirichlet_s, humidity, neutral,           &
    3554                   nesting_offline, time_since_reference_point
    3555 
    3556        USE indices,                                                            &
    3557            ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt
     3467           ONLY:  initializing_actions, message_string
    35583468
    35593469       IMPLICIT NONE
    3560        
    3561        INTEGER(iwp) ::  id_dynamic !< NetCDF id of dynamic input file
    3562        INTEGER(iwp) ::  n          !< running index for chemistry variables
    3563        INTEGER(iwp) ::  num_vars   !< number of variables in netcdf input file
    3564        INTEGER(iwp) ::  t          !< running index time dimension
    3565 !
    3566 !--    Skip input if no forcing from larger-scale models is applied.
    3567        IF ( .NOT. nesting_offline )  RETURN
    3568 
    3569 !
    3570 !--    CPU measurement
    3571        CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'start' )
    3572 
    3573 #if defined ( __netcdf )
    3574 !
    3575 !--    Open file in read-only mode
    3576        CALL open_read_file( TRIM( input_file_dynamic ) //                      &
    3577                             TRIM( coupling_char ), id_dynamic )
    3578 !
    3579 !--    Initialize INIFOR forcing.
    3580        IF ( .NOT. nest_offl%init )  THEN
    3581 !
    3582 !--       At first, inquire all variable names.
    3583           CALL inquire_num_variables( id_dynamic, num_vars )
    3584 !
    3585 !--       Allocate memory to store variable names.
    3586           ALLOCATE( nest_offl%var_names(1:num_vars) )
    3587           CALL inquire_variable_names( id_dynamic, nest_offl%var_names )
    3588 !
    3589 !--       Read time dimension, allocate memory and finally read time array
    3590           CALL netcdf_data_input_get_dimension_length( id_dynamic,             &
    3591                                                        nest_offl%nt, 'time' )
    3592 
    3593           IF ( check_existence( nest_offl%var_names, 'time' ) )  THEN
    3594              ALLOCATE( nest_offl%time(0:nest_offl%nt-1) )
    3595              CALL get_variable( id_dynamic, 'time', nest_offl%time )
    3596           ENDIF
    3597 !
    3598 !--       Read vertical dimension of scalar und w grid
    3599           CALL netcdf_data_input_get_dimension_length( id_dynamic,             &
    3600                                                        nest_offl%nzu, 'z' )
    3601           CALL netcdf_data_input_get_dimension_length( id_dynamic,             &
    3602                                                        nest_offl%nzw, 'zw' )
    3603 
    3604           IF ( check_existence( nest_offl%var_names, 'z' ) )  THEN
    3605              ALLOCATE( nest_offl%zu_atmos(1:nest_offl%nzu) )
    3606              CALL get_variable( id_dynamic, 'z', nest_offl%zu_atmos )
    3607           ENDIF
    3608           IF ( check_existence( nest_offl%var_names, 'zw' ) )  THEN
    3609              ALLOCATE( nest_offl%zw_atmos(1:nest_offl%nzw) )
    3610              CALL get_variable( id_dynamic, 'zw', nest_offl%zw_atmos )
    3611           ENDIF
    3612 
    3613 !
    3614 !--       Read surface pressure
    3615           IF ( check_existence( nest_offl%var_names,                           &
    3616                                 'surface_forcing_surface_pressure' ) )  THEN
    3617              ALLOCATE( nest_offl%surface_pressure(0:nest_offl%nt-1) )
    3618              CALL get_variable( id_dynamic,                                    &
    3619                                 'surface_forcing_surface_pressure',            &
    3620                                 nest_offl%surface_pressure )
    3621           ENDIF
    3622 !
    3623 !--       Set control flag to indicate that initialization is already done
    3624           nest_offl%init = .TRUE.
    3625 
    3626        ENDIF
    3627 
    3628 !
    3629 !--    Obtain time index for current input starting at 0.
    3630 !--    @todo: At the moment INIFOR and simulated time correspond
    3631 !--           to each other. If required, adjust to daytime.
    3632        nest_offl%tind = MINLOC( ABS( nest_offl%time -                          &
    3633                                      time_since_reference_point ), DIM = 1 )   &
    3634                         - 1
    3635        nest_offl%tind_p = nest_offl%tind + 1       
    3636 !
    3637 !--    Read geostrophic wind components
    3638        DO  t = nest_offl%tind, nest_offl%tind_p
    3639           CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', t+1,              &
    3640                                 nest_offl%ug(t-nest_offl%tind,nzb+1:nzt) )
    3641           CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', t+1,              &
    3642                                 nest_offl%vg(t-nest_offl%tind,nzb+1:nzt) )
    3643        ENDDO
    3644 !
    3645 !--    Read data at lateral and top boundaries. Please note, at left and
    3646 !--    right domain boundary, yz-layers are read for u, v, w, pt and q.
    3647 !--    For the v-component, the data starts at nysv, while for the other
    3648 !--    quantities the data starts at nys. This is equivalent at the north
    3649 !--    and south domain boundary for the u-component.
    3650 !--    Note, lateral data is also accessed by parallel IO, which is the reason
    3651 !--    why different arguments are passed depending on the boundary control
    3652 !--    flags. Cores that do not belong to the respective boundary just make
    3653 !--    a dummy read with count = 0, just in order to participate the collective
    3654 !--    operation.
    3655 !--    Read data for western boundary   
    3656        CALL get_variable( id_dynamic, 'ls_forcing_left_u',                     &
    3657                           nest_offl%u_left,                                    & ! array to be read
    3658                           MERGE( nys+1, 1, bc_dirichlet_l),                    & ! start index y direction
    3659                           MERGE( nzb+1, 1, bc_dirichlet_l),                    & ! start index z direction
    3660                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         & ! start index time dimension
    3661                           MERGE( nyn-nys+1, 0, bc_dirichlet_l),                & ! number of elements along y
    3662                           MERGE( nest_offl%nzu, 0, bc_dirichlet_l),            & ! number of elements alogn z
    3663                           MERGE( 2, 0, bc_dirichlet_l),                        & ! number of time steps (2 or 0)
    3664                           .TRUE. )                                               ! parallel IO when compiled accordingly
    3665      
    3666        CALL get_variable( id_dynamic, 'ls_forcing_left_v',                     &
    3667                           nest_offl%v_left,                                    &
    3668                           MERGE( nysv, 1, bc_dirichlet_l),                     &
    3669                           MERGE( nzb+1, 1, bc_dirichlet_l),                    &
    3670                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         &
    3671                           MERGE( nyn-nysv+1, 0, bc_dirichlet_l),               &
    3672                           MERGE( nest_offl%nzu, 0, bc_dirichlet_l),            &
    3673                           MERGE( 2, 0, bc_dirichlet_l),                        &
    3674                           .TRUE. )                                       
    3675 
    3676        CALL get_variable( id_dynamic, 'ls_forcing_left_w',                     &
    3677                           nest_offl%w_left,                                    &
    3678                           MERGE( nys+1, 1, bc_dirichlet_l),                    &
    3679                           MERGE( nzb+1, 1, bc_dirichlet_l),                    &
    3680                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),         &
    3681                           MERGE( nyn-nys+1, 0, bc_dirichlet_l),                &
    3682                           MERGE( nest_offl%nzw, 0, bc_dirichlet_l),            &
    3683                           MERGE( 2, 0, bc_dirichlet_l),                        &
    3684                           .TRUE. )   
    3685 
    3686        IF ( .NOT. neutral )  THEN
    3687           CALL get_variable( id_dynamic, 'ls_forcing_left_pt',                 &
    3688                              nest_offl%pt_left,                                &
    3689                              MERGE( nys+1, 1, bc_dirichlet_l),                 &
    3690                              MERGE( nzb+1, 1, bc_dirichlet_l),                 &
    3691                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),      &
    3692                              MERGE( nyn-nys+1, 0, bc_dirichlet_l),             &
    3693                              MERGE( nest_offl%nzu, 0, bc_dirichlet_l),         &
    3694                              MERGE( 2, 0, bc_dirichlet_l),                     &
    3695                              .TRUE. )
    3696        ENDIF
    3697 
    3698        IF ( humidity )  THEN
    3699           CALL get_variable( id_dynamic, 'ls_forcing_left_qv',                 &
    3700                              nest_offl%q_left,                                 &
    3701                              MERGE( nys+1, 1, bc_dirichlet_l),                 &
    3702                              MERGE( nzb+1, 1, bc_dirichlet_l),                 &
    3703                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),      &
    3704                              MERGE( nyn-nys+1, 0, bc_dirichlet_l),             &
    3705                              MERGE( nest_offl%nzu, 0, bc_dirichlet_l),         &
    3706                              MERGE( 2, 0, bc_dirichlet_l),                     &
    3707                              .TRUE. )
    3708        ENDIF
    3709        
    3710        IF ( air_chemistry )  THEN
    3711           DO  n = 1, UBOUND(nest_offl%var_names_chem_l, 1)
    3712              IF ( check_existence( nest_offl%var_names,                        &
    3713                                    nest_offl%var_names_chem_l(n) ) )  THEN 
    3714                 CALL get_variable( id_dynamic,                                 &
    3715                            TRIM( nest_offl%var_names_chem_l(n) ),              &
    3716                            nest_offl%chem_left(:,:,:,n),                       &
    3717                            MERGE( nys+1, 1, bc_dirichlet_l),                   &
    3718                            MERGE( nzb+1, 1, bc_dirichlet_l),                   &
    3719                            MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),        &
    3720                            MERGE( nyn-nys+1, 0, bc_dirichlet_l),               &
    3721                            MERGE( nest_offl%nzu, 0, bc_dirichlet_l),           &
    3722                            MERGE( 2, 0, bc_dirichlet_l),                       &
    3723                            .TRUE. )
    3724                 nest_offl%chem_from_file_l(n) = .TRUE.
    3725              ENDIF
    3726           ENDDO
    3727        ENDIF
    3728 !
    3729 !--    Read data for eastern boundary   
    3730        CALL get_variable( id_dynamic, 'ls_forcing_right_u',                    &
    3731                           nest_offl%u_right,                                   &
    3732                           MERGE( nys+1, 1, bc_dirichlet_r),                    &
    3733                           MERGE( nzb+1, 1, bc_dirichlet_r),                    &
    3734                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
    3735                           MERGE( nyn-nys+1, 0, bc_dirichlet_r),                &
    3736                           MERGE( nest_offl%nzu, 0, bc_dirichlet_r),            &
    3737                           MERGE( 2, 0, bc_dirichlet_r),                        &
    3738                           .TRUE. )                                             
    3739      
    3740        CALL get_variable( id_dynamic, 'ls_forcing_right_v',                    &
    3741                           nest_offl%v_right,                                   &
    3742                           MERGE( nysv, 1, bc_dirichlet_r),                     &
    3743                           MERGE( nzb+1, 1, bc_dirichlet_r),                    &
    3744                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
    3745                           MERGE( nyn-nysv+1, 0, bc_dirichlet_r),               &
    3746                           MERGE( nest_offl%nzu, 0, bc_dirichlet_r),            &
    3747                           MERGE( 2, 0, bc_dirichlet_r),                        &
    3748                           .TRUE. )                                             
    3749 
    3750        CALL get_variable( id_dynamic, 'ls_forcing_right_w',                    &
    3751                           nest_offl%w_right,                                   &
    3752                           MERGE( nys+1, 1, bc_dirichlet_r),                    &
    3753                           MERGE( nzb+1, 1, bc_dirichlet_r),                    &
    3754                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),         &
    3755                           MERGE( nyn-nys+1, 0, bc_dirichlet_r),                &
    3756                           MERGE( nest_offl%nzw, 0, bc_dirichlet_r),            &
    3757                           MERGE( 2, 0, bc_dirichlet_r),                        &
    3758                           .TRUE. )   
    3759 
    3760        IF ( .NOT. neutral )  THEN
    3761           CALL get_variable( id_dynamic, 'ls_forcing_right_pt',                &
    3762                              nest_offl%pt_right,                               &
    3763                              MERGE( nys+1, 1, bc_dirichlet_r),                 &
    3764                              MERGE( nzb+1, 1, bc_dirichlet_r),                 &
    3765                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),      &
    3766                              MERGE( nyn-nys+1, 0, bc_dirichlet_r),             &
    3767                              MERGE( nest_offl%nzu, 0, bc_dirichlet_r),         &
    3768                              MERGE( 2, 0, bc_dirichlet_r),                     &
    3769                              .TRUE. )
    3770        ENDIF
    3771 
    3772        IF ( humidity )  THEN
    3773           CALL get_variable( id_dynamic, 'ls_forcing_right_qv',                &
    3774                              nest_offl%q_right,                                &
    3775                              MERGE( nys+1, 1, bc_dirichlet_r),                 &
    3776                              MERGE( nzb+1, 1, bc_dirichlet_r),                 &
    3777                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),      &
    3778                              MERGE( nyn-nys+1, 0, bc_dirichlet_r),             &
    3779                              MERGE( nest_offl%nzu, 0, bc_dirichlet_r),         &
    3780                              MERGE( 2, 0, bc_dirichlet_r),                     &
    3781                              .TRUE. )
    3782        ENDIF
    3783        
    3784        IF ( air_chemistry )  THEN
    3785           DO  n = 1, UBOUND(nest_offl%var_names_chem_r, 1)
    3786              IF ( check_existence( nest_offl%var_names,                        &
    3787                                    nest_offl%var_names_chem_r(n) ) )  THEN     
    3788                 CALL get_variable( id_dynamic,                                 &
    3789                            TRIM( nest_offl%var_names_chem_r(n) ),              &
    3790                            nest_offl%chem_right(:,:,:,n),                      &
    3791                            MERGE( nys+1, 1, bc_dirichlet_r),                   &
    3792                            MERGE( nzb+1, 1, bc_dirichlet_r),                   &
    3793                            MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),        &
    3794                            MERGE( nyn-nys+1, 0, bc_dirichlet_r),               &
    3795                            MERGE( nest_offl%nzu, 0, bc_dirichlet_r),           &
    3796                            MERGE( 2, 0, bc_dirichlet_r),                       &
    3797                            .TRUE. )
    3798                 nest_offl%chem_from_file_r(n) = .TRUE.
    3799              ENDIF
    3800           ENDDO
    3801        ENDIF
    3802 !
    3803 !--    Read data for northern boundary
    3804        CALL get_variable( id_dynamic, 'ls_forcing_north_u',                    & ! array to be read
    3805                           nest_offl%u_north,                                   & ! start index x direction
    3806                           MERGE( nxlu, 1, bc_dirichlet_n ),                    & ! start index z direction
    3807                           MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
    3808                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
    3809                           MERGE( nxr-nxlu+1, 0, bc_dirichlet_n ),              & ! number of elements alogn z
    3810                           MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
    3811                           MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
    3812                           .TRUE. )                                             
    3813                                                                                
    3814        CALL get_variable( id_dynamic, 'ls_forcing_north_v',                    & ! array to be read
    3815                           nest_offl%v_north,                                   & ! start index x direction
    3816                           MERGE( nxl+1, 1, bc_dirichlet_n ),                   & ! start index z direction
    3817                           MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
    3818                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
    3819                           MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),               & ! number of elements alogn z
    3820                           MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
    3821                           MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
    3822                           .TRUE. )                                             
    3823                                                                                
    3824        CALL get_variable( id_dynamic, 'ls_forcing_north_w',                    & ! array to be read
    3825                           nest_offl%w_north,                                   & ! start index x direction
    3826                           MERGE( nxl+1, 1, bc_dirichlet_n ),                   & ! start index z direction
    3827                           MERGE( nzb+1, 1, bc_dirichlet_n ),                   & ! start index time dimension
    3828                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),        & ! number of elements along x
    3829                           MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),               & ! number of elements alogn z
    3830                           MERGE( nest_offl%nzw, 0, bc_dirichlet_n ),           & ! number of time steps (2 or 0)
    3831                           MERGE( 2, 0, bc_dirichlet_n ),                       & ! parallel IO when compiled accordingly
    3832                           .TRUE. )                                             
    3833                                                                                
    3834        IF ( .NOT. neutral )  THEN                                             
    3835           CALL get_variable( id_dynamic, 'ls_forcing_north_pt',                & ! array to be read
    3836                              nest_offl%pt_north,                               & ! start index x direction
    3837                              MERGE( nxl+1, 1, bc_dirichlet_n ),                & ! start index z direction
    3838                              MERGE( nzb+1, 1, bc_dirichlet_n ),                & ! start index time dimension
    3839                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),     & ! number of elements along x
    3840                              MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),            & ! number of elements alogn z
    3841                              MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),        & ! number of time steps (2 or 0)
    3842                              MERGE( 2, 0, bc_dirichlet_n ),                    & ! parallel IO when compiled accordingly
    3843                              .TRUE. )                                             
    3844        ENDIF                                                                   
    3845        IF ( humidity )  THEN                                                   
    3846           CALL get_variable( id_dynamic, 'ls_forcing_north_qv',                & ! array to be read
    3847                              nest_offl%q_north,                                & ! start index x direction
    3848                              MERGE( nxl+1, 1, bc_dirichlet_n ),                & ! start index z direction
    3849                              MERGE( nzb+1, 1, bc_dirichlet_n ),                & ! start index time dimension
    3850                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),     & ! number of elements along x
    3851                              MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),            & ! number of elements alogn z
    3852                              MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),        & ! number of time steps (2 or 0)
    3853                              MERGE( 2, 0, bc_dirichlet_n ),                    & ! parallel IO when compiled accordingly
    3854                              .TRUE. )                                             
    3855        ENDIF                                                                   
    3856                                                                                
    3857        IF ( air_chemistry )  THEN                                             
    3858           DO  n = 1, UBOUND(nest_offl%var_names_chem_n, 1)                     
    3859              IF ( check_existence( nest_offl%var_names,                        &
    3860                                    nest_offl%var_names_chem_n(n) ) )  THEN     
    3861                 CALL get_variable( id_dynamic,                                 &
    3862                            TRIM( nest_offl%var_names_chem_n(n) ),              &
    3863                            nest_offl%chem_north(:,:,:,n),                      &
    3864                            MERGE( nxl+1, 1, bc_dirichlet_n ),                  &
    3865                            MERGE( nzb+1, 1, bc_dirichlet_n ),                  &
    3866                            MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),       &
    3867                            MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),              &
    3868                            MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),          &
    3869                            MERGE( 2, 0, bc_dirichlet_n ),                      &
    3870                            .TRUE. )
    3871                 nest_offl%chem_from_file_n(n) = .TRUE.
    3872              ENDIF
    3873           ENDDO
    3874        ENDIF
    3875 !
    3876 !--    Read data for southern boundary
    3877        CALL get_variable( id_dynamic, 'ls_forcing_south_u',                    & ! array to be read
    3878                           nest_offl%u_south,                                   & ! start index x direction
    3879                           MERGE( nxlu, 1, bc_dirichlet_s ),                    & ! start index z direction
    3880                           MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
    3881                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
    3882                           MERGE( nxr-nxlu+1, 0, bc_dirichlet_s ),              & ! number of elements alogn z
    3883                           MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
    3884                           MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
    3885                           .TRUE. )                                             
    3886                                                                                
    3887        CALL get_variable( id_dynamic, 'ls_forcing_south_v',                    & ! array to be read
    3888                           nest_offl%v_south,                                   & ! start index x direction
    3889                           MERGE( nxl+1, 1, bc_dirichlet_s ),                   & ! start index z direction
    3890                           MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
    3891                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
    3892                           MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),               & ! number of elements alogn z
    3893                           MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
    3894                           MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
    3895                           .TRUE. )                                             
    3896                                                                                
    3897        CALL get_variable( id_dynamic, 'ls_forcing_south_w',                    & ! array to be read
    3898                           nest_offl%w_south,                                   & ! start index x direction
    3899                           MERGE( nxl+1, 1, bc_dirichlet_s ),                   & ! start index z direction
    3900                           MERGE( nzb+1, 1, bc_dirichlet_s ),                   & ! start index time dimension
    3901                           MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),        & ! number of elements along x
    3902                           MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),               & ! number of elements alogn z
    3903                           MERGE( nest_offl%nzw, 0, bc_dirichlet_s ),           & ! number of time steps (2 or 0)
    3904                           MERGE( 2, 0, bc_dirichlet_s ),                       & ! parallel IO when compiled accordingly
    3905                           .TRUE. )                                             
    3906                                                                                
    3907        IF ( .NOT. neutral )  THEN                                             
    3908           CALL get_variable( id_dynamic, 'ls_forcing_south_pt',                & ! array to be read
    3909                              nest_offl%pt_south,                               & ! start index x direction
    3910                              MERGE( nxl+1, 1, bc_dirichlet_s ),                & ! start index z direction
    3911                              MERGE( nzb+1, 1, bc_dirichlet_s ),                & ! start index time dimension
    3912                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),     & ! number of elements along x
    3913                              MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),            & ! number of elements alogn z
    3914                              MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),        & ! number of time steps (2 or 0)
    3915                              MERGE( 2, 0, bc_dirichlet_s ),                    & ! parallel IO when compiled accordingly
    3916                              .TRUE. )                                             
    3917        ENDIF                                                                   
    3918        IF ( humidity )  THEN                                                   
    3919           CALL get_variable( id_dynamic, 'ls_forcing_south_qv',                & ! array to be read
    3920                              nest_offl%q_south,                                & ! start index x direction
    3921                              MERGE( nxl+1, 1, bc_dirichlet_s ),                & ! start index z direction
    3922                              MERGE( nzb+1, 1, bc_dirichlet_s ),                & ! start index time dimension
    3923                              MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),     & ! number of elements along x
    3924                              MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),            & ! number of elements alogn z
    3925                              MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),        & ! number of time steps (2 or 0)
    3926                              MERGE( 2, 0, bc_dirichlet_s ),                    & ! parallel IO when compiled accordingly
    3927                              .TRUE. )                                             
    3928        ENDIF                                                                   
    3929                                                                                
    3930        IF ( air_chemistry )  THEN                                             
    3931           DO  n = 1, UBOUND(nest_offl%var_names_chem_s, 1)                     
    3932              IF ( check_existence( nest_offl%var_names,                        &
    3933                                    nest_offl%var_names_chem_s(n) ) )  THEN     
    3934                 CALL get_variable( id_dynamic,                                 &
    3935                            TRIM( nest_offl%var_names_chem_s(n) ),              &
    3936                            nest_offl%chem_south(:,:,:,n),                      &
    3937                            MERGE( nxl+1, 1, bc_dirichlet_s ),                  &
    3938                            MERGE( nzb+1, 1, bc_dirichlet_s ),                  &
    3939                            MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),       &
    3940                            MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),              &
    3941                            MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),          &
    3942                            MERGE( 2, 0, bc_dirichlet_s ),                      &
    3943                            .TRUE. )
    3944                 nest_offl%chem_from_file_s(n) = .TRUE.
    3945              ENDIF
    3946           ENDDO
    3947        ENDIF
    3948 !
    3949 !--    Top boundary
    3950        CALL get_variable( id_dynamic, 'ls_forcing_top_u',                      &
    3951                              nest_offl%u_top(0:1,nys:nyn,nxlu:nxr),            &
    3952                              nxlu, nys+1, nest_offl%tind+1,                    &
    3953                              nxr-nxlu+1, nyn-nys+1, 2, .TRUE. )
    3954 
    3955        CALL get_variable( id_dynamic, 'ls_forcing_top_v',                      &
    3956                              nest_offl%v_top(0:1,nysv:nyn,nxl:nxr),            &
    3957                              nxl+1, nysv, nest_offl%tind+1,                    &
    3958                              nxr-nxl+1, nyn-nysv+1, 2, .TRUE. )
    3959                              
    3960        CALL get_variable( id_dynamic, 'ls_forcing_top_w',                      &
    3961                              nest_offl%w_top(0:1,nys:nyn,nxl:nxr),             &
    3962                              nxl+1, nys+1, nest_offl%tind+1,                   &
    3963                              nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
    3964                              
    3965        IF ( .NOT. neutral )  THEN
    3966           CALL get_variable( id_dynamic, 'ls_forcing_top_pt',                  &
    3967                                 nest_offl%pt_top(0:1,nys:nyn,nxl:nxr),         &
    3968                                 nxl+1, nys+1, nest_offl%tind+1,                &
    3969                                 nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
    3970        ENDIF
    3971        IF ( humidity )  THEN
    3972           CALL get_variable( id_dynamic, 'ls_forcing_top_qv',                  &
    3973                                 nest_offl%q_top(0:1,nys:nyn,nxl:nxr),          &
    3974                                 nxl+1, nys+1, nest_offl%tind+1,                &
    3975                                 nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
    3976        ENDIF
    3977        
    3978        IF ( air_chemistry )  THEN
    3979           DO  n = 1, UBOUND(nest_offl%var_names_chem_t, 1)
    3980              IF ( check_existence( nest_offl%var_names,                     &
    3981                                    nest_offl%var_names_chem_t(n) ) )  THEN     
    3982                 CALL get_variable( id_dynamic,                                 &
    3983                               TRIM( nest_offl%var_names_chem_t(n) ),           &
    3984                               nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,n),       &
    3985                               nxl+1, nys+1, nest_offl%tind+1,                  &
    3986                               nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
    3987                 nest_offl%chem_from_file_t(n) = .TRUE.
    3988              ENDIF
    3989           ENDDO
    3990        ENDIF
    3991 
    3992 !
    3993 !--    Close input file
    3994        CALL close_input_file( id_dynamic )
    3995 #endif
    3996 !
    3997 !--    End of CPU measurement
    3998        CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'stop' )
    3999 
    4000     END SUBROUTINE netcdf_data_input_offline_nesting
    4001 
    4002 
    4003 !------------------------------------------------------------------------------!
    4004 ! Description:
    4005 ! ------------
    4006 !> Checks input file for consistency and minimum requirements.
    4007 !------------------------------------------------------------------------------!
    4008     SUBROUTINE netcdf_data_input_check_dynamic
    4009 
    4010        USE control_parameters,                                                 &
    4011            ONLY:  initializing_actions, message_string, nesting_offline
    4012 
    4013        IMPLICIT NONE
    4014 
    4015 !
    4016 !--    In case of forcing, check whether dynamic input file is present
    4017        IF ( .NOT. input_pids_dynamic  .AND.  nesting_offline  )  THEN
    4018           message_string = 'nesting_offline = .TRUE. requires dynamic '  //    &
    4019                             'input file ' //                                   &
    4020                             TRIM( input_file_dynamic ) // TRIM( coupling_char )
    4021           CALL message( 'netcdf_data_input_mod', 'PA0546', 1, 2, 0, 6, 0 )
    4022        ENDIF
    40233470!
    40243471!--    Dynamic input file must also be present if initialization via inifor is
     
    52694716!> Get dimension array for a given dimension
    52704717!------------------------------------------------------------------------------!
    5271      SUBROUTINE netcdf_data_input_get_dimension_length( id, dim_len,           &
    5272                                                         variable_name )
     4718     SUBROUTINE get_dimension_length( id, dim_len, variable_name )
    52734719       USE pegrid
    52744720
     
    52864732!--    First, inquire dimension ID
    52874733       nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim )
    5288        CALL handle_error( 'netcdf_data_input_get_dimension_length', 526,       &
    5289                           variable_name )
     4734       CALL handle_error( 'get_dimension_length', 526, variable_name )
    52904735!
    52914736!--    Inquire dimension length
    52924737       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len )
    5293        CALL handle_error( 'netcdf_data_input_get_dimension_length', 526,       &
    5294                           variable_name )
     4738       CALL handle_error( 'get_dimension_length', 526, variable_name )
    52954739
    52964740#endif
    5297     END SUBROUTINE netcdf_data_input_get_dimension_length
     4741    END SUBROUTINE get_dimension_length
    52984742
    52994743!------------------------------------------------------------------------------!
  • palm/trunk/SOURCE/plant_canopy_model_mod.f90

    r4221 r4226  
    2222! Current revisions:
    2323! ------------------
    24 ! Bugfix, missing initialization of heating rate
     24!
    2525!
    2626! Former revisions:
    2727! -----------------
    2828! $Id$
     29! Bugfix, missing initialization of heating rate
     30!
     31! 4221 2019-09-09 08:50:35Z suehring
    2932! Further bugfix in 3d data output for plant canopy
    3033!
  • palm/trunk/SOURCE/radiation_model_mod.f90

    r4210 r4226  
    2828! -----------------
    2929! $Id$
     30! - Netcdf input routine for dimension length renamed
     31! - Define time variable for external radiation input relative to time_utc_init
     32!
     33! 4210 2019-09-02 13:07:09Z suehring
    3034! - Revise steering of splitting diffuse and direct radiation
    3135! - Bugfixes in checks
     
    3438!
    3539! 4208 2019-09-02 09:01:07Z suehring
    36 ! Bugfix in accessing albedo_pars in the clear-sky branch (merge from branch)
     40! Bugfix in accessing albedo_pars in the clear-sky branch
     41! (merge from branch resler)
    3742!
    3843! 4198 2019-08-29 15:17:48Z gronemeier
     
    259264               close_input_file,                                               &
    260265               get_attribute,                                                  &
     266               get_dimension_length,                                           &
    261267               get_variable,                                                   &
    262268               inquire_num_variables,                                          &
     
    264270               input_file_dynamic,                                             &
    265271               input_pids_dynamic,                                             &
    266                netcdf_data_input_get_dimension_length,                         &
    267272               num_var_pids,                                                   &
    268273               pids_id,                                                        &
     
    25102515!--       Input time dimension.
    25112516          IF ( check_existence( vars_pids, 'time_rad' ) )  THEN
    2512              CALL netcdf_data_input_get_dimension_length( pids_id,             &
    2513                                                           ntime,               &
    2514                                                           'time_rad' )
     2517             CALL get_dimension_length( pids_id, ntime, 'time_rad' )
    25152518         
    25162519             ALLOCATE( time_rad_f%var1d(0:ntime-1) )
     
    26372640          ENDIF
    26382641         
    2639           IF ( time_rad_f%var1d(0) /= 0.0_wp )  THEN
     2642          IF ( time_rad_f%var1d(0) /= time_utc_init )  THEN
    26402643             message_string = 'External radiation forcing: first point in ' // &
    2641                               'time is /= 0.0.'
     2644                              'time is /= time_utc_init.'
    26422645             CALL message( 'radiation_init', 'PA0313', 1, 2, 0, 6, 0 )
    26432646          ENDIF
    26442647         
    2645           IF ( end_time - spinup_time > time_rad_f%var1d(ntime-1) )  THEN
     2648          IF ( end_time - spinup_time > time_rad_f%var1d(ntime-1)              &
     2649                                      - time_utc_init )  THEN
    26462650             message_string = 'External radiation forcing does not cover ' //  &
    26472651                              'the entire simulation time.'
     
    28322836       ELSE
    28332837          t = 0
    2834           DO WHILE ( time_rad_f%var1d(t) <= time_since_reference_point )
     2838          DO WHILE ( time_rad_f%var1d(t) <=                                    &
     2839                     time_since_reference_point + time_utc_init )
    28352840             t = t + 1
    28362841          ENDDO
     
    28382843          tm = MAX( t-1, 0 )
    28392844         
    2840           fac_dt = ( time_since_reference_point - time_rad_f%var1d(tm) + dt_3d ) &
     2845          fac_dt = ( time_since_reference_point + time_utc_init                &
     2846                   - time_rad_f%var1d(tm) + dt_3d )                            &
    28412847                 / ( time_rad_f%var1d(t)  - time_rad_f%var1d(tm) )
    28422848          fac_dt = MIN( 1.0_wp, fac_dt )
  • palm/trunk/SOURCE/salsa_mod.f90

    r4182 r4226  
    2626! -----------------
    2727! $Id$
     28! Netcdf input routine for dimension length renamed
     29!
     30! 4182 2019-08-22 15:20:23Z scharf
    2831! Corrected "Former revisions" section
    2932!
     
    17571760
    17581761    USE netcdf_data_input_mod,                                                                     &
    1759         ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
     1762        ONLY:  check_existence, close_input_file, get_dimension_length,                            &
     1763               get_attribute, get_variable,                                                        &
    17601764               inquire_num_variables, inquire_variable_names,                                      &
    1761                netcdf_data_input_get_dimension_length, open_read_file
     1765               open_read_file
    17621766
    17631767    IMPLICIT NONE
     
    18361840!
    18371841!--       Inquire vertical dimension and number of aerosol chemical components
    1838           CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
     1842          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
    18391843          IF ( pr_nz /= nz )  THEN
    18401844             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
     
    18421846             CALL message( 'aerosol_init', 'PA0601', 1, 2, 0, 6, 0 )
    18431847          ENDIF
    1844           CALL netcdf_data_input_get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
     1848          CALL get_dimension_length( id_dyn, pr_ncc, 'composition_index' )
    18451849!
    18461850!--       Allocate memory
     
    19151919!
    19161920!--          Bin mean diameters in the input file
    1917              CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nbins, 'Dmid')
     1921             CALL get_dimension_length( id_dyn, pr_nbins, 'Dmid')
    19181922             IF ( pr_nbins /= nbins_aerosol )  THEN
    19191923                message_string = 'Number of size bins in init_atmosphere_aerosol does not match '  &
     
    20672071!
    20682072!--       Inquire dimensions:
    2069           CALL netcdf_data_input_get_dimension_length( id_dyn, pr_nz, 'z' )
     2073          CALL get_dimension_length( id_dyn, pr_nz, 'z' )
    20702074          IF ( pr_nz /= nz )  THEN
    20712075             WRITE( message_string, * ) 'Number of inifor horizontal grid points does not match '//&
     
    83888392        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
    83898393               inquire_num_variables, inquire_variable_names,                                      &
    8390                netcdf_data_input_get_dimension_length, open_read_file, street_type_f
     8394               get_dimension_length, open_read_file, street_type_f
    83918395
    83928396    USE surface_mod,                                                                               &
     
    85258529!
    85268530!--          Read the index and name of chemical components
    8527              CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncc,         &
     8531             CALL get_dimension_length( id_salsa, aero_emission_att%ncc,         &
    85288532                                                          'composition_index' )
    85298533             ALLOCATE( aero_emission_att%cc_index(1:aero_emission_att%ncc) )
     
    85988602!
    85998603!--             Get number of emission categories and allocate emission arrays
    8600                 CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%ncat,     &
    8601                                                              'ncat' )
     8604                CALL get_dimension_length( id_salsa, aero_emission_att%ncat, 'ncat' )
    86028605                ALLOCATE( aero_emission_att%cat_index(1:aero_emission_att%ncat),                   &
    86038606                          aero_emission_att%rho(1:aero_emission_att%ncat),                         &
     
    86368639!--             For each hour of year:
    86378640                IF ( check_existence( aero_emission_att%var_names, 'nhoursyear' ) )  THEN
    8638                    CALL netcdf_data_input_get_dimension_length( id_salsa,                          &
    8639                                                         aero_emission_att%nhoursyear, 'nhoursyear' )
     8641                   CALL get_dimension_length( id_salsa,                                            &
     8642                                              aero_emission_att%nhoursyear, 'nhoursyear' )
    86408643                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
    86418644                                                   1:aero_emission_att%nhoursyear) )
     
    86458648!--             Based on the month, day and hour:
    86468649                ELSEIF ( check_existence( aero_emission_att%var_names, 'nmonthdayhour' ) )  THEN
    8647                    CALL netcdf_data_input_get_dimension_length( id_salsa,                          &
    8648                                                                 aero_emission_att%nmonthdayhour,   &
    8649                                                                 'nmonthdayhour' )
     8650                   CALL get_dimension_length( id_salsa,                                            &
     8651                                              aero_emission_att%nmonthdayhour,                     &
     8652                                              'nmonthdayhour' )
    86508653                   ALLOCATE( aero_emission_att%etf(1:aero_emission_att%ncat,                       &
    86518654                                                   1:aero_emission_att%nmonthdayhour) )
     
    87348737!
    87358738!--             Number of aerosol size bins in the emission data
    8736                 CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nbins,    &
    8737                                                              'Dmid' )
     8739                CALL get_dimension_length( id_salsa, aero_emission_att%nbins, 'Dmid' )
    87388740                IF ( aero_emission_att%nbins /= nbins_aerosol )  THEN
    87398741                   message_string = 'The number of size bins in aerosol input data does not ' //   &
     
    87438745!
    87448746!--             Number of time steps in the emission data
    8745                 CALL netcdf_data_input_get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
     8747                CALL get_dimension_length( id_salsa, aero_emission_att%nt, 'time')
    87468748!
    87478749!--             Allocate bin diameters, time and mass fraction array
     
    91249126        ONLY:  check_existence, close_input_file, get_attribute, get_variable,                     &
    91259127               inquire_num_variables, inquire_variable_names,                                      &
    9126                netcdf_data_input_get_dimension_length, open_read_file
     9128               get_dimension_length, open_read_file
    91279129
    91289130    USE surface_mod,                                                                               &
     
    91749176!
    91759177!--    Read the index and name of chemical components
    9176        CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%n_emiss_species,    &
    9177                                                     'nspecies' )
     9178       CALL get_dimension_length( id_chem, chem_emission_att%n_emiss_species, 'nspecies' )
    91789179       ALLOCATE( chem_emission_att%species_index(1:chem_emission_att%n_emiss_species) )
    91799180       CALL get_variable( id_chem, 'emission_index', chem_emission_att%species_index )
     
    92219222!
    92229223!--       Get number of emission categories and allocate emission arrays
    9223           CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
     9224          CALL get_dimension_length( id_chem, chem_emission_att%ncat, 'ncat' )
    92249225          ALLOCATE( chem_emission_att%cat_index(1:chem_emission_att%ncat),                         &
    92259226                    time_factor(1:chem_emission_att%ncat) )
     
    92359236!--       For each hour of year:
    92369237          IF ( check_existence( var_names, 'nhoursyear' ) )  THEN
    9237              CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nhoursyear,   &
    9238                                                           'nhoursyear' )
     9238             CALL get_dimension_length( id_chem, chem_emission_att%nhoursyear, 'nhoursyear' )
    92399239             ALLOCATE( chem_emission_att%hourly_emis_time_factor(1:chem_emission_att%ncat,         &
    92409240                                                                 1:chem_emission_att%nhoursyear) )
     
    92459245!--       Based on the month, day and hour:
    92469246          ELSEIF ( check_existence( var_names, 'nmonthdayhour' ) )  THEN
    9247              CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%nmonthdayhour,&
    9248                                                           'nmonthdayhour' )
     9247             CALL get_dimension_length( id_chem, chem_emission_att%nmonthdayhour, 'nmonthdayhour' )
    92499248             ALLOCATE( chem_emission_att%mdh_emis_time_factor(1:chem_emission_att%ncat,            &
    92509249                                                              1:chem_emission_att%nmonthdayhour) )
     
    92849283!
    92859284!--       Number of time steps in the emission data
    9286           CALL netcdf_data_input_get_dimension_length( id_chem, chem_emission_att%dt_emission,     &
    9287                                                        'time' )
     9285          CALL get_dimension_length( id_chem, chem_emission_att%dt_emission, 'time' )
    92889286!
    92899287!--       Allocate and read time
  • palm/trunk/SOURCE/time_integration.f90

    r4182 r4226  
    2525! -----------------
    2626! $Id$
     27! Changes in interface for the offline nesting
     28!
     29! 4182 2019-08-22 15:20:23Z scharf
    2730! Corrected "Former revisions" section
    2831!
     
    257260
    258261    USE nesting_offl_mod,                                                                          &
    259         ONLY:  nesting_offl_bc, nesting_offl_mass_conservation
     262        ONLY:  nesting_offl_bc,                                                                    &
     263               nesting_offl_geostrophic_wind,                                                      &
     264               nesting_offl_input,                                                                 &
     265               nesting_offl_interpolation_factor,                                                  &
     266               nesting_offl_mass_conservation
    260267
    261268    USE netcdf_data_input_mod,                                                                     &
    262         ONLY:  chem_emis, chem_emis_att, nest_offl, netcdf_data_input_offline_nesting
     269        ONLY:  chem_emis, chem_emis_att
    263270
    264271    USE ocean_mod,                                                                                 &
     
    566573       ENDIF
    567574!
    568 !--    If forcing by larger-scale models is applied, check if new data
    569 !--    at domain boundaries need to be read.
    570        IF ( nesting_offline ) THEN
    571           IF ( nest_offl%time(nest_offl%tind_p) <= time_since_reference_point ) &
    572                CALL netcdf_data_input_offline_nesting
    573        ENDIF
    574 
     575!--    Input of boundary data.
     576       IF ( nesting_offline )  CALL nesting_offl_input
    575577!
    576578!--    Execute all other module actions routunes
     
    955957!
    956958!--       Map forcing data derived from larger scale model onto domain
    957 !--       boundaries.
     959!--       boundaries. Further, update geostrophic wind components.
    958960          IF ( nesting_offline  .AND.  intermediate_timestep_count ==                              &
    959                                        intermediate_timestep_count_max  )                          &
     961                                       intermediate_timestep_count_max  )  THEN
     962!--          Determine interpolation factor before boundary conditions and geostrophic wind
     963!--          is updated.
     964             CALL nesting_offl_interpolation_factor
    960965             CALL nesting_offl_bc
     966             CALL nesting_offl_geostrophic_wind
     967          ENDIF
    961968!
    962969!--       Impose a turbulent inflow using synthetic generated turbulence.
  • palm/trunk/SOURCE/virtual_measurement_mod.f90

    r4182 r4226  
    2525! -----------------
    2626! $Id$
     27! Netcdf input routine for dimension length renamed
     28!
     29! 4182 2019-08-22 15:20:23Z scharf
    2730! Corrected "Former revisions" section
    2831!
     
    435438 
    436439    USE netcdf_data_input_mod,                                                 &
    437         ONLY:  init_model, input_file_vm,                                      &
    438                netcdf_data_input_get_dimension_length,                         &
    439                netcdf_data_input_att, netcdf_data_input_var
     440        ONLY:  get_dimension_length,                                           &
     441               init_model,                                                     &
     442               input_file_vm,                                                  &
     443               netcdf_data_input_att,                                          &
     444               netcdf_data_input_var
    440445       
    441446    IMPLICIT NONE
     
    648653!--          For non-stationary measurements read the number of trajectories
    649654!--          and the number of time coordinates.
    650              CALL netcdf_data_input_get_dimension_length( vmea_general%id_vm, &
    651                                                           vmea(l)%ntraj,      &
    652                                                           "traj" //           &
    653                                                           TRIM( dum ) )
    654              CALL netcdf_data_input_get_dimension_length( vmea_general%id_vm, &
    655                                                           dim_ntime,          &
    656                                                           "ntime" //          &
    657                                                           TRIM( dum ) )
     655             CALL get_dimension_length( vmea_general%id_vm,                    &
     656                                        vmea(l)%ntraj,                         &
     657                                        "traj" //                              &
     658                                        TRIM( dum ) )
     659             CALL get_dimension_length( vmea_general%id_vm,                    &
     660                                        dim_ntime,                             &
     661                                        "ntime" //                             &
     662                                        TRIM( dum ) )
    658663!
    659664!--       For stationary measurements the dimension for UTM and time
Note: See TracChangeset for help on using the changeset viewer.