Changeset 3710 for palm/trunk
- Timestamp:
- Jan 30, 2019 6:11:19 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r3692 r3710 25 25 ! ----------------- 26 26 ! $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 27 31 ! Revise check for soil moisture higher than its saturation value 28 32 ! … … 1338 1342 IMPLICIT NONE 1339 1343 1344 INTEGER(iwp) :: i !< running index, x-dimension 1345 INTEGER(iwp) :: j !< running index, y-dimension 1340 1346 INTEGER(iwp) :: k !< running index, z-dimension 1341 1347 … … 1374 1380 CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 ) 1375 1381 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. 1377 1482 IF ( TRIM( surface_type ) == 'vegetation' ) THEN 1378 1483 … … 1396 1501 'requires setting of vegetation_coverage'// & 1397 1502 '/= 9999999.9' 1398 1503 CALL message( 'lsm_check_parameters', 'PA0401', 1, 2, 0, 6, 0 ) 1399 1504 ENDIF 1400 1505 … … 1487 1592 message_string = 'non-default setting of dz_soil '// & 1488 1593 'does not allow to use pavement_type /= 0)' 1489 1490 1594 CALL message( 'lsm_check_parameters', 'PA0341', 1, 2, 0, 6, 0 ) 1595 ENDIF 1491 1596 1492 1597 IF ( pavement_type == 0 ) THEN -
palm/trunk/SOURCE/urban_surface_mod.f90
r3705 r3710 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Check if building type is set within a valid range. 31 ! 32 ! 3705 2019-01-29 19:56:39Z suehring 30 33 ! make nzb_wall public, required for virtual-measurements 31 34 ! … … 2625 2628 ONLY: bc_pt_b, bc_q_b, constant_flux_layer, large_scale_forcing, & 2626 2629 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 2628 2638 ! 2629 2639 !-- Dirichlet boundary conditions are required as the surface fluxes are … … 2659 2669 message_string = 'topography /= "flat" is required '// & 2660 2670 '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 ) 2662 2672 ENDIF 2663 2673 ! … … 2667 2677 '"naheatlayers" can not be larger than'// & 2668 2678 ' 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 2670 2702 ENDIF 2671 2703
Note: See TracChangeset
for help on using the changeset viewer.