Changeset 3710 for palm/trunk


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

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

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

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

    r3692 r3710  
    2525! -----------------
    2626! $Id$
     27! Check if soil-, water-, pavement- and vegetation types are set within a valid
     28! range.
     29!
     30! 3692 2019-01-23 14:45:49Z suehring
    2731! Revise check for soil moisture higher than its saturation value
    2832!
     
    13381342    IMPLICIT NONE
    13391343
     1344    INTEGER(iwp) ::  i        !< running index, x-dimension
     1345    INTEGER(iwp) ::  j        !< running index, y-dimension
    13401346    INTEGER(iwp) ::  k        !< running index, z-dimension
    13411347
     
    13741380       CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 )
    13751381    ENDIF
    1376 
     1382!
     1383!-- Check if soil types are set within a valid range.
     1384    IF ( TRIM( surface_type ) == 'vegetation'  .OR.                            &
     1385         TRIM( surface_type ) == 'pavement'    .OR.                            &
     1386         TRIM( surface_type ) == 'netcdf' )  THEN
     1387       IF ( soil_type < LBOUND( soil_pars, 2 )  .AND.                          &
     1388            soil_type > UBOUND( soil_pars, 2 ) )  THEN
     1389          WRITE( message_string, * ) 'soil_type = ', soil_type, ' is out ' //  &
     1390                                     'of the valid range'
     1391          CALL message( 'lsm_check_parameters', 'PA0452', 2, 2, 0, 6, 0 )
     1392       ENDIF
     1393       IF ( soil_type_f%from_file )  THEN
     1394          DO  i = nxl, nxr
     1395             DO  j = nys, nyn
     1396                IF ( soil_type_f%var_2d(j,i) /= soil_type_f%fill  .AND.        &
     1397                     ( soil_type_f%var_2d(j,i) < LBOUND( soil_pars, 2 )  .OR.  &
     1398                       soil_type_f%var_2d(j,i) > UBOUND( soil_pars, 2 ) ) )  THEN
     1399                   WRITE( message_string, * ) 'soil_type = is out  of ' //     &
     1400                                        'the valid range at (j,i) = ', j, i
     1401                   CALL message( 'lsm_check_parameters', 'PA0452', 2, 2, 0, 6, 0 )
     1402                ENDIF
     1403             ENDDO
     1404          ENDDO
     1405       ENDIF
     1406    ENDIF
     1407!
     1408!-- Check if vegetation types are set within a valid range.   
     1409    IF ( TRIM( surface_type ) == 'vegetation'  .OR.                            &
     1410         TRIM( surface_type ) == 'netcdf' )  THEN
     1411       IF ( vegetation_type < LBOUND( vegetation_pars, 2 )  .AND.              &
     1412            vegetation_type > UBOUND( vegetation_pars, 2 ) )  THEN
     1413          WRITE( message_string, * ) 'vegetation_type = ', vegetation_type,    &
     1414                                     ' is out of the valid range'
     1415          CALL message( 'lsm_check_parameters', 'PA0526', 2, 2, 0, 6, 0 )
     1416       ENDIF
     1417       IF ( vegetation_type_f%from_file )  THEN
     1418          DO  i = nxl, nxr
     1419             DO  j = nys, nyn
     1420                IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .AND.&
     1421              ( vegetation_type_f%var(j,i) < LBOUND( vegetation_pars, 2 )  .OR.&
     1422                vegetation_type_f%var(j,i) > UBOUND( vegetation_pars, 2 ) ) )  &
     1423                THEN
     1424                   WRITE( message_string, * ) 'vegetation_type = is out of ' //&
     1425                                        'the valid range at (j,i) = ', j, i
     1426                   CALL message( 'lsm_check_parameters', 'PA0526', 2, 2, 0, 6, 0 )
     1427                ENDIF
     1428             ENDDO
     1429          ENDDO
     1430       ENDIF
     1431    ENDIF
     1432!
     1433!-- Check if pavement types are set within a valid range.   
     1434    IF ( TRIM( surface_type ) == 'pavement'  .OR.                              &
     1435         TRIM( surface_type ) == 'netcdf' )  THEN
     1436       IF ( pavement_type < LBOUND( pavement_pars, 2 )  .AND.                  &
     1437            pavement_type > UBOUND( pavement_pars, 2 ) )  THEN
     1438          WRITE( message_string, * ) 'pavement_type = ', pavement_type,        &
     1439                                     ' is out of the valid range'
     1440          CALL message( 'lsm_check_parameters', 'PA0527', 2, 2, 0, 6, 0 )
     1441       ENDIF
     1442       IF ( pavement_type_f%from_file )  THEN
     1443          DO  i = nxl, nxr
     1444             DO  j = nys, nyn
     1445                IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill  .AND.   &
     1446              ( pavement_type_f%var(j,i) < LBOUND( pavement_pars, 2 )  .OR.    &
     1447                pavement_type_f%var(j,i) > UBOUND( pavement_pars, 2 ) ) )  THEN
     1448                   WRITE( message_string, * ) 'pavement_type = is out of ' //  &
     1449                                        'the valid range at (j,i) = ', j, i
     1450                   CALL message( 'lsm_check_parameters', 'PA0527', 2, 2, 0, 6, 0 )
     1451                ENDIF
     1452             ENDDO
     1453          ENDDO
     1454       ENDIF
     1455    ENDIF
     1456!
     1457!-- Check if water types are set within a valid range.   
     1458    IF ( TRIM( surface_type ) == 'water'  .OR.                                 &
     1459         TRIM( surface_type ) == 'netcdf' )  THEN
     1460       IF ( water_type < LBOUND( water_pars, 2 )  .AND.                        &
     1461            water_type > UBOUND( water_pars, 2 ) )  THEN
     1462          WRITE( message_string, * ) 'water_type = ', water_type,              &
     1463                                     ' is out of the valid range'
     1464          CALL message( 'lsm_check_parameters', 'PA0528', 2, 2, 0, 6, 0 )
     1465       ENDIF
     1466       IF ( water_type_f%from_file )  THEN
     1467          DO  i = nxl, nxr
     1468             DO  j = nys, nyn
     1469                IF ( water_type_f%var(j,i) /= water_type_f%fill  .AND.         &
     1470              ( water_type_f%var(j,i) < LBOUND( water_pars, 2 )  .OR.          &
     1471                water_type_f%var(j,i) > UBOUND( water_pars, 2 ) ) )  THEN
     1472                   WRITE( message_string, * ) 'water_type = is out  of ' //    &
     1473                                        'the valid range at (j,i) = ', j, i
     1474                   CALL message( 'lsm_check_parameters', 'PA0528', 2, 2, 0, 6, 0 )
     1475                ENDIF
     1476             ENDDO
     1477          ENDDO
     1478       ENDIF
     1479    ENDIF
     1480!
     1481!-- Check further settings for consistency.
    13771482    IF ( TRIM( surface_type ) == 'vegetation' )  THEN
    13781483   
     
    13961501                              'requires setting of vegetation_coverage'//      &
    13971502                              '/= 9999999.9'
    1398                 CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
     1503             CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 )
    13991504          ENDIF
    14001505
     
    14871592          message_string = 'non-default setting of dz_soil '//                  &
    14881593                           'does not allow to use pavement_type /= 0)'
    1489              CALL message( 'lsm_check_parameters', 'PA0341', 1, 2, 0, 6, 0 )
    1490           ENDIF
     1594          CALL message( 'lsm_check_parameters', 'PA0341', 1, 2, 0, 6, 0 )
     1595       ENDIF
    14911596
    14921597       IF ( pavement_type == 0 )  THEN 
  • 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.