Ignore:
Timestamp:
Jan 30, 2019 6:11:19 PM (5 years ago)
Author:
suehring
Message:

Check if building-, water-, pavement-, vegetation- and soil types are within a valid range

File:
1 edited

Legend:

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

    r3705 r3710  
    2828! -----------------
    2929! $Id$
     30! Check if building type is set within a valid range.
     31!
     32! 3705 2019-01-29 19:56:39Z suehring
    3033! make nzb_wall public, required for virtual-measurements
    3134!
     
    26252628           ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, large_scale_forcing,   &
    26262629                  lsf_surf, topography
    2627 
     2630                 
     2631       USE netcdf_data_input_mod,                                             &
     2632            ONLY:  building_type_f
     2633
     2634       IMPLICIT NONE           
     2635                 
     2636       INTEGER(iwp) ::  i        !< running index, x-dimension
     2637       INTEGER(iwp) ::  j        !< running index, y-dimension
    26282638!
    26292639!--    Dirichlet boundary conditions are required as the surface fluxes are
     
    26592669          message_string = 'topography /= "flat" is required '//               &
    26602670                           'when using the urban surface model'
    2661           CALL message( 'check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
     2671          CALL message( 'usm_check_parameters', 'PA0592', 1, 2, 0, 6, 0 )
    26622672       ENDIF
    26632673!
     
    26672677                           '"naheatlayers" can not be larger than'//           &
    26682678                           ' number of domain layers "nzt"'
    2669           CALL message( 'check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
     2679          CALL message( 'usm_check_parameters', 'PA0593', 1, 2, 0, 6, 0 )
     2680       ENDIF
     2681!
     2682!--    Check if building types are set within a valid range.   
     2683       IF ( building_type < LBOUND( building_pars, 2 )  .AND.                 &
     2684            building_type > UBOUND( building_pars, 2 ) )  THEN
     2685          WRITE( message_string, * ) 'building_type = ', building_type,        &
     2686                                     ' is out of the valid range'
     2687          CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
     2688       ENDIF
     2689       IF ( building_type_f%from_file )  THEN
     2690          DO  i = nxl, nxr
     2691             DO  j = nys, nyn
     2692                IF ( building_type_f%var(j,i) /= building_type_f%fill  .AND.   &
     2693              ( building_type_f%var(j,i) < LBOUND( building_pars, 2 )  .OR.    &
     2694                building_type_f%var(j,i) > UBOUND( building_pars, 2 ) ) )      &
     2695                THEN
     2696                   WRITE( message_string, * ) 'building_type = is out of ' //  &
     2697                                        'the valid range at (j,i) = ', j, i
     2698                   CALL message( 'usm_check_parameters', 'PA0529', 2, 2, 0, 6, 0 )
     2699                ENDIF
     2700             ENDDO
     2701          ENDDO
    26702702       ENDIF
    26712703
Note: See TracChangeset for help on using the changeset viewer.