Changeset 3710 for palm/trunk/SOURCE/land_surface_model_mod.f90
- Timestamp:
- Jan 30, 2019 6:11:19 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/land_surface_model_mod.f90 (modified) (5 diffs)
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
Note: See TracChangeset
for help on using the changeset viewer.
