Changeset 2898 for palm


Ignore:
Timestamp:
Mar 15, 2018 1:03:01 PM (6 years ago)
Author:
suehring
Message:

Check dimensions in static input files, further checks for building type.

File:
1 edited

Legend:

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

    r2897 r2898  
    2525! -----------------
    2626! $Id$
     27! Check if each building has a type. Further, check if dimensions in static
     28! input file match the model dimensions.
     29!
     30! 2897 2018-03-15 11:47:16Z suehring
    2731! Relax restrictions for topography input, terrain and building heights can be
    2832! input separately and are not mandatory any more.
     
    8589
    8690    USE pegrid
    87 
     91!
     92!-- Define type for dimensions.
     93    TYPE dims_xy
     94       INTEGER(iwp) :: nx                             !< dimension length in x
     95       INTEGER(iwp) :: ny                             !< dimension length in y
     96       REAL(wp), DIMENSION(:), ALLOCATABLE :: x       !< dimension array in x
     97       REAL(wp), DIMENSION(:), ALLOCATABLE :: y       !< dimension array in y
     98    END TYPE dims_xy
    8899!
    89100!-- Define data type for nesting in larger-scale models like COSMO.
     
    287298       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  pars_xyz          !< respective parameters, level of detail = 2
    288299    END TYPE pars
    289 
    290     TYPE(force_type) ::  force !< input variable for lateral and top boundaries derived from large-scale model 
     300!
     301!-- Define variables
     302    TYPE(dims_xy)    ::  dim_static !< data structure for x, y-dimension in static input file
     303
     304    TYPE(force_type) ::  force     !< data structure for data input at lateral and top boundaries (provided by Inifor) 
    291305
    292306    TYPE(init_type) ::  init_3d    !< data structure for the initialization of the 3D flow and soil fields
     
    16601674                ALLOCATE( var_names(1:num_vars) )
    16611675                CALL inquire_variable_names( id_topo, var_names )
     1676!
     1677!--             Read x, y - dimensions
     1678                CALL get_dimension_length( id_topo, dim_static%nx, 'x' )
     1679                CALL get_dimension_length( id_topo, dim_static%ny, 'y' )
     1680                ALLOCATE( dim_static%x(0:dim_static%nx-1) )
     1681                ALLOCATE( dim_static%y(0:dim_static%ny-1) )
     1682                CALL get_variable( id_topo, 'x', dim_static%x )
     1683                CALL get_variable( id_topo, 'y', dim_static%y )
    16621684!
    16631685!--             Terrain height. First, get variable-related _FillValue attribute
     
    27472769           ONLY:  land_surface, message_string, urban_surface
    27482770
     2771       USE grid_variables,                                                     &
     2772           ONLY:  dx, dy
     2773
    27492774       USE indices,                                                            &
    2750            ONLY:  nxl, nxr, nyn, nys
     2775           ONLY:  nx, nxl, nxr, ny, nyn, nys
    27512776
    27522777       IMPLICIT NONE
     
    27602785!
    27612786!--    Return if no static input file is available
    2762        IF ( .NOT. input_pids_static )  RETURN 
     2787       IF ( .NOT. input_pids_static )  RETURN
     2788!
     2789!--    Check whether dimension size in input file matches the model dimensions
     2790       IF ( dim_static%nx-1 /= nx  .OR.  dim_static%ny-1 /= ny )  THEN
     2791          message_string = 'Static input file: horizontal dimension in ' //    &
     2792                           'x- and/or y-direction ' //                         &
     2793                           'do not match the respective model dimension'
     2794          CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
     2795       ENDIF
     2796!
     2797!--    Check if grid spacing of provided input data matches the respective
     2798!--    grid spacing in the model.
     2799       IF ( dim_static%x(1) - dim_static%x(0) /= dx  .OR.                      &
     2800            dim_static%y(1) - dim_static%y(0) /= dy )  THEN
     2801          message_string = 'Static input file: horizontal grid spacing ' //    &
     2802                           'in x- and/or y-direction ' //                      &
     2803                           'do not match the respective model grid spacing.'
     2804          CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
     2805       ENDIF
    27632806!
    27642807!--    Check orography for fill-values. For the moment, give an error message.
     
    30413084!
    30423085!--          Check if building_type is set at each building
    3043 !              IF ( building_type_f%from_file  .AND.  buildings_f%from_file )  THEN
    3044 !                 IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1  .AND.       &
    3045 !                      building_type_f%var(j,i) == building_type_f%fill )  THEN
    3046 !                       WRITE( message_string, * ) 'Each building requires ' //  &
    3047 !                                        ' a type. i, j = ', i, j
    3048 !                       CALL message( 'netcdf_data_input_mod', 'PA0999',         &
    3049 !                                      2, 2, 0, 6, 0 )
    3050 !                 ENDIF
    3051 !              ENDIF
     3086             IF ( building_type_f%from_file  .AND.  buildings_f%from_file )  THEN
     3087                IF ( buildings_f%lod == 1 )  THEN
     3088                   IF ( buildings_f%var_2d(j,i)  /= buildings_f%fill1  .AND.   &
     3089                        building_type_f%var(j,i) == building_type_f%fill )  THEN
     3090                      WRITE( message_string, * ) 'Each building requires ' //  &
     3091                                                 'a type in case the ' //      &
     3092                                                 'urban-surface model is ' //  &
     3093                                                 'applied. i, j = ', i, j
     3094                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
     3095                                     2, 2, 0, 6, 0 )
     3096                   ENDIF
     3097                ENDIF
     3098                IF ( buildings_f%lod == 2 )  THEN
     3099                   IF ( ANY( buildings_f%var_3d(:,j,i) == 1 )                  &
     3100                  .AND. building_type_f%var(j,i) == building_type_f%fill )  THEN
     3101                      WRITE( message_string, * ) 'Each building requires ' //  &
     3102                                                 'a type in case the ' //      &
     3103                                                 'urban-surface model is ' //  &
     3104                                                 'applied. i, j = ', i, j
     3105                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
     3106                                     2, 2, 0, 6, 0 )
     3107                   ENDIF
     3108                ENDIF
     3109             ENDIF
    30523110!
    30533111!--          Check albedo parameters. If albedo_type is 0, all parameters 
Note: See TracChangeset for help on using the changeset viewer.