Changeset 3337 for palm/trunk/SOURCE/urban_surface_mod.f90
- Timestamp:
- Oct 12, 2018 3:17:09 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
- Property svn:mergeinfo changed
/palm/branches/resler/SOURCE (added) merged: 2136-2138,2324-2325,2655,2679,2684,2694-2695,2783-2786,2810,2985,3000,3015,3017,3060-3061,3063,3154,3317,3319-3321,3323,3335-3336
- Property svn:mergeinfo changed
-
palm/trunk/SOURCE/urban_surface_mod.f90
r3274 r3337 28 28 ! ----------------- 29 29 ! $Id$ 30 ! Add output variables usm_rad_pc_inlw, usm_rad_pc_insw* 31 ! 32 ! 3274 2018-09-24 15:42:55Z knoop 30 33 ! Modularization of all bulk cloud physics code components 31 34 ! … … 349 352 spinup_pt_mean, spinup_time, time_do3d, dt_do3d, & 350 353 average_count_3d, varnamelength, urban_surface, & 351 plant_canopy 354 plant_canopy, dz 352 355 353 356 USE cpulog, & … … 381 384 surfinl, surfinlwdif, rad_sw_in_dir, rad_sw_in_diff, & 382 385 rad_lw_in_diff, surfouts, surfoutl, surfoutsl, surfoutll, surf, & 383 surfl, nsurfl, nsurfs, surfstart, pcbinsw, pcbinlw,&384 iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l,&386 surfl, nsurfl, pcbinsw, pcbinlw, pcbinswdir, & 387 pcbinswdif, iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l, & 385 388 inorth_l, isouth_l, ieast_l, iwest_l, id, & 386 iz, iy, ix, idir, jdir, kdir, nsurf_type, nsurf, idsvf, ndsvf, & 387 iup_a, idown_a, inorth_a, isouth_a, ieast_a, iwest_a, & 389 iz, iy, ix, nsurf, idsvf, ndsvf, & 388 390 idcsf, ndcsf, kdcsf, pct, & 389 startland, endland, startwall, endwall, skyvf, skyvft 391 startland, endland, startwall, endwall, skyvf, skyvft, nzub, & 392 nzut, nzpt, npcbl, pcbl 390 393 391 394 USE statistics, & … … 414 417 INTEGER(iwp) :: pedestrian_category = 2 !< default category for wall surface in pedestrian zone 415 418 INTEGER(iwp) :: roof_category = 2 !< default category for root surface 419 REAL(wp) :: roughness_concrete = 0.001_wp !< roughness length of average concrete surface 416 420 ! 417 421 !-- Indices of input attributes for (above) ground floor level … … 605 609 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in surface after last reflection 606 610 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in surface after last reflection 611 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinlw_av !< Average of pcbinlw 612 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinsw_av !< Average of pcbinsw 613 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswdir_av !< Average of pcbinswdir 614 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswdif_av !< Average of pcbinswdif 615 REAL(wp), DIMENSION(:), ALLOCATABLE :: pcbinswref_av !< Average of pcbinswref 607 616 608 617 … … 1260 1269 !-- find the real name of the variable 1261 1270 ids = -1 1271 l = -1 1262 1272 var = TRIM(variable) 1263 1273 DO i = 0, nd-1 1264 1274 k = len(TRIM(var)) 1265 1275 j = len(TRIM(dirname(i))) 1266 IF ( var(k-j+1:k) == dirname(i) ) THEN1276 IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) ) THEN 1267 1277 ids = i 1268 1278 idsint = dirint(ids) … … 1271 1281 ENDIF 1272 1282 ENDDO 1283 l = idsint - 2 ! horisontal direction index - terible hack ! 1284 IF ( l < 0 .OR. l > 3 ) THEN 1285 l = -1 1286 END IF 1273 1287 IF ( ids == -1 ) THEN 1274 1288 var = TRIM(variable) … … 1311 1325 CASE ( 'usm_rad_net' ) 1312 1326 !-- array of complete radiation balance 1313 IF ( .NOT. ALLOCATED(surf_usm_h%rad_net_av) ) THEN1327 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%rad_net_av) ) THEN 1314 1328 ALLOCATE( surf_usm_h%rad_net_av(1:surf_usm_h%ns) ) 1315 1329 surf_usm_h%rad_net_av = 0.0_wp 1330 ELSE 1331 IF ( .NOT. ALLOCATED(surf_usm_v(l)%rad_net_av) ) THEN 1332 ALLOCATE( surf_usm_v(l)%rad_net_av(1:surf_usm_v(l)%ns) ) 1333 surf_usm_v(l)%rad_net_av = 0.0_wp 1334 ENDIF 1316 1335 ENDIF 1317 DO l = 0, 31318 IF ( .NOT. ALLOCATED(surf_usm_v(l)%rad_net_av) ) THEN1319 ALLOCATE( surf_usm_v(l)%rad_net_av(1:surf_usm_v(l)%ns) )1320 surf_usm_v(l)%rad_net_av = 0.0_wp1321 ENDIF1322 ENDDO1323 1336 1324 1337 CASE ( 'usm_rad_insw' ) … … 1398 1411 ENDIF 1399 1412 1413 CASE ( 'usm_rad_pc_inlw' ) 1414 !-- array of of lw radiation absorbed in plant canopy 1415 IF ( .NOT. ALLOCATED(pcbinlw_av) ) THEN 1416 ALLOCATE( pcbinlw_av(1:npcbl) ) 1417 pcbinlw_av = 0.0_wp 1418 ENDIF 1419 1420 CASE ( 'usm_rad_pc_insw' ) 1421 !-- array of of sw radiation absorbed in plant canopy 1422 IF ( .NOT. ALLOCATED(pcbinsw_av) ) THEN 1423 ALLOCATE( pcbinsw_av(1:npcbl) ) 1424 pcbinsw_av = 0.0_wp 1425 ENDIF 1426 1427 CASE ( 'usm_rad_pc_inswdir' ) 1428 !-- array of of direct sw radiation absorbed in plant canopy 1429 IF ( .NOT. ALLOCATED(pcbinswdir_av) ) THEN 1430 ALLOCATE( pcbinswdir_av(1:npcbl) ) 1431 pcbinswdir_av = 0.0_wp 1432 ENDIF 1433 1434 CASE ( 'usm_rad_pc_inswdif' ) 1435 !-- array of of diffuse sw radiation absorbed in plant canopy 1436 IF ( .NOT. ALLOCATED(pcbinswdif_av) ) THEN 1437 ALLOCATE( pcbinswdif_av(1:npcbl) ) 1438 pcbinswdif_av = 0.0_wp 1439 ENDIF 1440 1441 CASE ( 'usm_rad_pc_inswref' ) 1442 !-- array of of reflected sw radiation absorbed in plant canopy 1443 IF ( .NOT. ALLOCATED(pcbinswref_av) ) THEN 1444 ALLOCATE( pcbinswref_av(1:npcbl) ) 1445 pcbinswref_av = 0.0_wp 1446 ENDIF 1447 1400 1448 CASE ( 'usm_rad_hf' ) 1401 1449 !-- array of heat flux from radiation for surfaces after i-th reflection 1402 IF ( .NOT. ALLOCATED(surf_usm_h%surfhf_av) ) THEN1450 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%surfhf_av) ) THEN 1403 1451 ALLOCATE( surf_usm_h%surfhf_av(1:surf_usm_h%ns) ) 1404 1452 surf_usm_h%surfhf_av = 0.0_wp 1405 ENDIF 1406 DO l = 0, 3 1453 ELSE 1407 1454 IF ( .NOT. ALLOCATED(surf_usm_v(l)%surfhf_av) ) THEN 1408 1455 ALLOCATE( surf_usm_v(l)%surfhf_av(1:surf_usm_v(l)%ns) ) 1409 1456 surf_usm_v(l)%surfhf_av = 0.0_wp 1410 1457 ENDIF 1411 END DO1458 ENDIF 1412 1459 1413 1460 CASE ( 'usm_wshf' ) 1414 1461 !-- array of sensible heat flux from surfaces 1415 1462 !-- land surfaces 1416 IF ( .NOT. ALLOCATED(surf_usm_h%wshf_eb_av) ) THEN1463 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%wshf_eb_av) ) THEN 1417 1464 ALLOCATE( surf_usm_h%wshf_eb_av(1:surf_usm_h%ns) ) 1418 1465 surf_usm_h%wshf_eb_av = 0.0_wp 1419 ENDIF 1420 DO l = 0, 3 1466 ELSE 1421 1467 IF ( .NOT. ALLOCATED(surf_usm_v(l)%wshf_eb_av) ) THEN 1422 1468 ALLOCATE( surf_usm_v(l)%wshf_eb_av(1:surf_usm_v(l)%ns) ) 1423 1469 surf_usm_v(l)%wshf_eb_av = 0.0_wp 1424 1470 ENDIF 1425 END DO1471 ENDIF 1426 1472 ! 1427 1473 !-- Please note, the following output quantities belongs to the … … 1431 1477 CASE ( 'usm_wghf' ) 1432 1478 !-- array of heat flux from ground (wall, roof, land) 1433 IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_av) ) THEN1479 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%wghf_eb_av) ) THEN 1434 1480 ALLOCATE( surf_usm_h%wghf_eb_av(1:surf_usm_h%ns) ) 1435 1481 surf_usm_h%wghf_eb_av = 0.0_wp 1436 ENDIF 1437 DO l = 0, 3 1482 ELSE 1438 1483 IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_av) ) THEN 1439 1484 ALLOCATE( surf_usm_v(l)%wghf_eb_av(1:surf_usm_v(l)%ns) ) 1440 1485 surf_usm_v(l)%wghf_eb_av = 0.0_wp 1441 1486 ENDIF 1442 END DO1487 ENDIF 1443 1488 1444 1489 CASE ( 'usm_wghf_window' ) 1445 1490 !-- array of heat flux from window ground (wall, roof, land) 1446 IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_window_av) ) THEN1491 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%wghf_eb_window_av) ) THEN 1447 1492 ALLOCATE( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) ) 1448 1493 surf_usm_h%wghf_eb_window_av = 0.0_wp 1449 ENDIF 1450 DO l = 0, 3 1494 ELSE 1451 1495 IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_window_av) ) THEN 1452 1496 ALLOCATE( surf_usm_v(l)%wghf_eb_window_av(1:surf_usm_v(l)%ns) ) 1453 1497 surf_usm_v(l)%wghf_eb_window_av = 0.0_wp 1454 1498 ENDIF 1455 END DO1499 ENDIF 1456 1500 1457 1501 CASE ( 'usm_wghf_green' ) 1458 1502 !-- array of heat flux from green ground (wall, roof, land) 1459 IF ( .NOT. ALLOCATED(surf_usm_h%wghf_eb_green_av) ) THEN1503 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%wghf_eb_green_av) ) THEN 1460 1504 ALLOCATE( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) ) 1461 1505 surf_usm_h%wghf_eb_green_av = 0.0_wp 1462 ENDIF 1463 DO l = 0, 3 1506 ELSE 1464 1507 IF ( .NOT. ALLOCATED(surf_usm_v(l)%wghf_eb_green_av) ) THEN 1465 1508 ALLOCATE( surf_usm_v(l)%wghf_eb_green_av(1:surf_usm_v(l)%ns) ) 1466 1509 surf_usm_v(l)%wghf_eb_green_av = 0.0_wp 1467 1510 ENDIF 1468 END DO1511 ENDIF 1469 1512 1470 1513 CASE ( 'usm_iwghf' ) 1471 1514 !-- array of heat flux from indoor ground (wall, roof, land) 1472 IF ( .NOT. ALLOCATED(surf_usm_h%iwghf_eb_av) ) THEN1515 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%iwghf_eb_av) ) THEN 1473 1516 ALLOCATE( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) ) 1474 1517 surf_usm_h%iwghf_eb_av = 0.0_wp 1475 ENDIF 1476 DO l = 0, 3 1518 ELSE 1477 1519 IF ( .NOT. ALLOCATED(surf_usm_v(l)%iwghf_eb_av) ) THEN 1478 1520 ALLOCATE( surf_usm_v(l)%iwghf_eb_av(1:surf_usm_v(l)%ns) ) 1479 1521 surf_usm_v(l)%iwghf_eb_av = 0.0_wp 1480 1522 ENDIF 1481 END DO1523 ENDIF 1482 1524 1483 1525 CASE ( 'usm_iwghf_window' ) 1484 1526 !-- array of heat flux from indoor window ground (wall, roof, land) 1485 IF ( .NOT. ALLOCATED(surf_usm_h%iwghf_eb_window_av) ) THEN1527 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%iwghf_eb_window_av) ) THEN 1486 1528 ALLOCATE( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) ) 1487 1529 surf_usm_h%iwghf_eb_window_av = 0.0_wp 1488 ENDIF 1489 DO l = 0, 3 1530 ELSE 1490 1531 IF ( .NOT. ALLOCATED(surf_usm_v(l)%iwghf_eb_window_av) ) THEN 1491 1532 ALLOCATE( surf_usm_v(l)%iwghf_eb_window_av(1:surf_usm_v(l)%ns) ) 1492 1533 surf_usm_v(l)%iwghf_eb_window_av = 0.0_wp 1493 1534 ENDIF 1494 END DO1535 ENDIF 1495 1536 1496 1537 CASE ( 'usm_t_surf' ) 1497 1538 !-- surface temperature for surfaces 1498 IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_av) ) THEN1539 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_surf_av) ) THEN 1499 1540 ALLOCATE( surf_usm_h%t_surf_av(1:surf_usm_h%ns) ) 1500 1541 surf_usm_h%t_surf_av = 0.0_wp 1501 ENDIF 1502 DO l = 0, 3 1542 ELSE 1503 1543 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_av) ) THEN 1504 1544 ALLOCATE( surf_usm_v(l)%t_surf_av(1:surf_usm_v(l)%ns) ) 1505 1545 surf_usm_v(l)%t_surf_av = 0.0_wp 1506 1546 ENDIF 1507 END DO1547 ENDIF 1508 1548 1509 1549 CASE ( 'usm_t_surf_window' ) 1510 1550 !-- surface temperature for window surfaces 1511 IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_window_av) ) THEN1551 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_surf_window_av) ) THEN 1512 1552 ALLOCATE( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) ) 1513 1553 surf_usm_h%t_surf_window_av = 0.0_wp 1514 ENDIF 1515 DO l = 0, 3 1554 ELSE 1516 1555 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_window_av) ) THEN 1517 1556 ALLOCATE( surf_usm_v(l)%t_surf_window_av(1:surf_usm_v(l)%ns) ) 1518 1557 surf_usm_v(l)%t_surf_window_av = 0.0_wp 1519 1558 ENDIF 1520 END DO1559 ENDIF 1521 1560 1522 1561 CASE ( 'usm_t_surf_green' ) 1523 1562 !-- surface temperature for green surfaces 1524 IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_green_av) ) THEN1563 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_surf_green_av) ) THEN 1525 1564 ALLOCATE( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) ) 1526 1565 surf_usm_h%t_surf_green_av = 0.0_wp 1527 ENDIF 1528 DO l = 0, 3 1566 ELSE 1529 1567 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_green_av) ) THEN 1530 1568 ALLOCATE( surf_usm_v(l)%t_surf_green_av(1:surf_usm_v(l)%ns) ) 1531 1569 surf_usm_v(l)%t_surf_green_av = 0.0_wp 1532 1570 ENDIF 1533 END DO1571 ENDIF 1534 1572 1535 1573 CASE ( 'usm_t_surf_10cm' ) 1536 1574 !-- near surface temperature for whole surfaces 1537 IF ( .NOT. ALLOCATED(surf_usm_h%t_surf_10cm_av) ) THEN1575 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_surf_10cm_av) ) THEN 1538 1576 ALLOCATE( surf_usm_h%t_surf_10cm_av(1:surf_usm_h%ns) ) 1539 1577 surf_usm_h%t_surf_10cm_av = 0.0_wp 1540 ENDIF 1541 DO l = 0, 3 1578 ELSE 1542 1579 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_surf_10cm_av) ) THEN 1543 1580 ALLOCATE( surf_usm_v(l)%t_surf_10cm_av(1:surf_usm_v(l)%ns) ) 1544 1581 surf_usm_v(l)%t_surf_10cm_av = 0.0_wp 1545 1582 ENDIF 1546 END DO1583 ENDIF 1547 1584 1548 1585 CASE ( 'usm_t_wall' ) 1549 1586 !-- wall temperature for iwl layer of walls and land 1550 IF ( .NOT. ALLOCATED(surf_usm_h%t_wall_av) ) THEN1587 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_wall_av) ) THEN 1551 1588 ALLOCATE( surf_usm_h%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) ) 1552 1589 surf_usm_h%t_wall_av = 0.0_wp 1553 ENDIF 1554 DO l = 0, 3 1590 ELSE 1555 1591 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_wall_av) ) THEN 1556 1592 ALLOCATE( surf_usm_v(l)%t_wall_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) ) 1557 1593 surf_usm_v(l)%t_wall_av = 0.0_wp 1558 1594 ENDIF 1559 END DO1595 ENDIF 1560 1596 1561 1597 CASE ( 'usm_t_window' ) 1562 1598 !-- window temperature for iwl layer of walls and land 1563 IF ( .NOT. ALLOCATED(surf_usm_h%t_window_av) ) THEN1599 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_window_av) ) THEN 1564 1600 ALLOCATE( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) ) 1565 1601 surf_usm_h%t_window_av = 0.0_wp 1566 ENDIF 1567 DO l = 0, 3 1602 ELSE 1568 1603 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_window_av) ) THEN 1569 1604 ALLOCATE( surf_usm_v(l)%t_window_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) ) 1570 1605 surf_usm_v(l)%t_window_av = 0.0_wp 1571 1606 ENDIF 1572 END DO1607 ENDIF 1573 1608 1574 1609 CASE ( 'usm_t_green' ) 1575 1610 !-- green temperature for iwl layer of walls and land 1576 IF ( .NOT. ALLOCATED(surf_usm_h%t_green_av) ) THEN1611 IF ( l == -1 .AND. .NOT. ALLOCATED(surf_usm_h%t_green_av) ) THEN 1577 1612 ALLOCATE( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) ) 1578 1613 surf_usm_h%t_green_av = 0.0_wp 1579 ENDIF 1580 DO l = 0, 3 1614 ELSE 1581 1615 IF ( .NOT. ALLOCATED(surf_usm_v(l)%t_green_av) ) THEN 1582 1616 ALLOCATE( surf_usm_v(l)%t_green_av(nzb_wall:nzt_wall,1:surf_usm_v(l)%ns) ) 1583 1617 surf_usm_v(l)%t_green_av = 0.0_wp 1584 1618 ENDIF 1585 END DO1619 ENDIF 1586 1620 1587 1621 CASE DEFAULT … … 1596 1630 CASE ( 'usm_rad_net' ) 1597 1631 !-- array of complete radiation balance 1598 DO m = 1, surf_usm_h%ns 1599 surf_usm_h%rad_net_av(m) = & 1600 surf_usm_h%rad_net_av(m) + & 1601 surf_usm_h%rad_net_l(m) 1602 ENDDO 1603 DO l = 0, 3 1632 IF ( l == -1 ) THEN 1633 DO m = 1, surf_usm_h%ns 1634 surf_usm_h%rad_net_av(m) = & 1635 surf_usm_h%rad_net_av(m) + & 1636 surf_usm_h%rad_net_l(m) 1637 ENDDO 1638 ELSE 1604 1639 DO m = 1, surf_usm_v(l)%ns 1605 1640 surf_usm_v(l)%rad_net_av(m) = & … … 1607 1642 surf_usm_v(l)%rad_net_l(m) 1608 1643 ENDDO 1609 END DO1610 1644 ENDIF 1645 1611 1646 CASE ( 'usm_rad_insw' ) 1612 1647 !-- array of sw radiation falling to surface after i-th reflection … … 1700 1735 ENDDO 1701 1736 1737 CASE ( 'usm_rad_pc_inlw' ) 1738 pcbinlw_av(:) = pcbinlw_av(:) + pcbinlw(:) 1739 1740 CASE ( 'usm_rad_pc_insw' ) 1741 pcbinsw_av(:) = pcbinsw_av(:) + pcbinsw(:) 1742 1743 CASE ( 'usm_rad_pc_inswdir' ) 1744 pcbinswdir_av(:) = pcbinswdir_av(:) + pcbinswdir(:) 1745 1746 CASE ( 'usm_rad_pc_inswdif' ) 1747 pcbinswdif_av(:) = pcbinswdif_av(:) + pcbinswdif(:) 1748 1749 CASE ( 'usm_rad_pc_inswref' ) 1750 pcbinswref_av(:) = pcbinswref_av(:) + pcbinsw(:) & 1751 - pcbinswdir(:) & 1752 - pcbinswdif(:) 1753 1702 1754 CASE ( 'usm_rad_hf' ) 1703 1755 !-- array of heat flux from radiation for surfaces after i-th reflection 1704 DO m = 1, surf_usm_h%ns 1705 surf_usm_h%surfhf_av(m) = & 1706 surf_usm_h%surfhf_av(m) + & 1707 surf_usm_h%surfhf(m) 1708 ENDDO 1709 DO l = 0, 3 1756 IF ( l == -1 ) THEN 1757 DO m = 1, surf_usm_h%ns 1758 surf_usm_h%surfhf_av(m) = & 1759 surf_usm_h%surfhf_av(m) + & 1760 surf_usm_h%surfhf(m) 1761 ENDDO 1762 ELSE 1710 1763 DO m = 1, surf_usm_v(l)%ns 1711 1764 surf_usm_v(l)%surfhf_av(m) = & … … 1713 1766 surf_usm_v(l)%surfhf(m) 1714 1767 ENDDO 1715 END DO1768 ENDIF 1716 1769 1717 1770 CASE ( 'usm_wshf' ) 1718 1771 !-- array of sensible heat flux from surfaces (land, roof, wall) 1719 DO m = 1, surf_usm_h%ns 1720 surf_usm_h%wshf_eb_av(m) = & 1721 surf_usm_h%wshf_eb_av(m) + & 1722 surf_usm_h%wshf_eb(m) 1723 ENDDO 1724 DO l = 0, 3 1772 IF ( l == -1 ) THEN 1773 DO m = 1, surf_usm_h%ns 1774 surf_usm_h%wshf_eb_av(m) = & 1775 surf_usm_h%wshf_eb_av(m) + & 1776 surf_usm_h%wshf_eb(m) 1777 ENDDO 1778 ELSE 1725 1779 DO m = 1, surf_usm_v(l)%ns 1726 1780 surf_usm_v(l)%wshf_eb_av(m) = & … … 1728 1782 surf_usm_v(l)%wshf_eb(m) 1729 1783 ENDDO 1730 END DO1784 ENDIF 1731 1785 1732 1786 CASE ( 'usm_wghf' ) 1733 1787 !-- array of heat flux from ground (wall, roof, land) 1734 DO m = 1, surf_usm_h%ns 1735 surf_usm_h%wghf_eb_av(m) = & 1736 surf_usm_h%wghf_eb_av(m) + & 1737 surf_usm_h%wghf_eb(m) 1738 ENDDO 1739 DO l = 0, 3 1788 IF ( l == -1 ) THEN 1789 DO m = 1, surf_usm_h%ns 1790 surf_usm_h%wghf_eb_av(m) = & 1791 surf_usm_h%wghf_eb_av(m) + & 1792 surf_usm_h%wghf_eb(m) 1793 ENDDO 1794 ELSE 1740 1795 DO m = 1, surf_usm_v(l)%ns 1741 1796 surf_usm_v(l)%wghf_eb_av(m) = & … … 1743 1798 surf_usm_v(l)%wghf_eb(m) 1744 1799 ENDDO 1745 END DO1800 ENDIF 1746 1801 1747 1802 CASE ( 'usm_wghf_window' ) 1748 1803 !-- array of heat flux from window ground (wall, roof, land) 1749 DO m = 1, surf_usm_h%ns 1750 surf_usm_h%wghf_eb_window_av(m) = & 1751 surf_usm_h%wghf_eb_window_av(m) + & 1752 surf_usm_h%wghf_eb_window(m) 1753 ENDDO 1754 DO l = 0, 3 1804 IF ( l == -1 ) THEN 1805 DO m = 1, surf_usm_h%ns 1806 surf_usm_h%wghf_eb_window_av(m) = & 1807 surf_usm_h%wghf_eb_window_av(m) + & 1808 surf_usm_h%wghf_eb_window(m) 1809 ENDDO 1810 ELSE 1755 1811 DO m = 1, surf_usm_v(l)%ns 1756 1812 surf_usm_v(l)%wghf_eb_window_av(m) = & … … 1758 1814 surf_usm_v(l)%wghf_eb_window(m) 1759 1815 ENDDO 1760 END DO1816 ENDIF 1761 1817 1762 1818 CASE ( 'usm_wghf_green' ) 1763 1819 !-- array of heat flux from green ground (wall, roof, land) 1764 DO m = 1, surf_usm_h%ns 1765 surf_usm_h%wghf_eb_green_av(m) = & 1766 surf_usm_h%wghf_eb_green_av(m) + & 1767 surf_usm_h%wghf_eb_green(m) 1768 ENDDO 1769 DO l = 0, 3 1820 IF ( l == -1 ) THEN 1821 DO m = 1, surf_usm_h%ns 1822 surf_usm_h%wghf_eb_green_av(m) = & 1823 surf_usm_h%wghf_eb_green_av(m) + & 1824 surf_usm_h%wghf_eb_green(m) 1825 ENDDO 1826 ELSE 1770 1827 DO m = 1, surf_usm_v(l)%ns 1771 1828 surf_usm_v(l)%wghf_eb_green_av(m) = & … … 1773 1830 surf_usm_v(l)%wghf_eb_green(m) 1774 1831 ENDDO 1775 END DO1832 ENDIF 1776 1833 1777 1834 CASE ( 'usm_iwghf' ) 1778 1835 !-- array of heat flux from indoor ground (wall, roof, land) 1779 DO m = 1, surf_usm_h%ns 1780 surf_usm_h%iwghf_eb_av(m) = & 1781 surf_usm_h%iwghf_eb_av(m) + & 1782 surf_usm_h%iwghf_eb(m) 1783 ENDDO 1784 DO l = 0, 3 1836 IF ( l == -1 ) THEN 1837 DO m = 1, surf_usm_h%ns 1838 surf_usm_h%iwghf_eb_av(m) = & 1839 surf_usm_h%iwghf_eb_av(m) + & 1840 surf_usm_h%iwghf_eb(m) 1841 ENDDO 1842 ELSE 1785 1843 DO m = 1, surf_usm_v(l)%ns 1786 1844 surf_usm_v(l)%iwghf_eb_av(m) = & … … 1788 1846 surf_usm_v(l)%iwghf_eb(m) 1789 1847 ENDDO 1790 END DO1848 ENDIF 1791 1849 1792 1850 CASE ( 'usm_iwghf_window' ) 1793 1851 !-- array of heat flux from indoor window ground (wall, roof, land) 1794 DO m = 1, surf_usm_h%ns 1795 surf_usm_h%iwghf_eb_window_av(m) = & 1796 surf_usm_h%iwghf_eb_window_av(m) + & 1797 surf_usm_h%iwghf_eb_window(m) 1798 ENDDO 1799 DO l = 0, 3 1852 IF ( l == -1 ) THEN 1853 DO m = 1, surf_usm_h%ns 1854 surf_usm_h%iwghf_eb_window_av(m) = & 1855 surf_usm_h%iwghf_eb_window_av(m) + & 1856 surf_usm_h%iwghf_eb_window(m) 1857 ENDDO 1858 ELSE 1800 1859 DO m = 1, surf_usm_v(l)%ns 1801 1860 surf_usm_v(l)%iwghf_eb_window_av(m) = & … … 1803 1862 surf_usm_v(l)%iwghf_eb_window(m) 1804 1863 ENDDO 1805 END DO1864 ENDIF 1806 1865 1807 1866 CASE ( 'usm_t_surf' ) 1808 1867 !-- surface temperature for surfaces 1809 DO m = 1, surf_usm_h%ns 1810 surf_usm_h%t_surf_av(m) = & 1811 surf_usm_h%t_surf_av(m) + & 1812 t_surf_h(m) 1813 ENDDO 1814 DO l = 0, 3 1868 IF ( l == -1 ) THEN 1869 DO m = 1, surf_usm_h%ns 1870 surf_usm_h%t_surf_av(m) = & 1871 surf_usm_h%t_surf_av(m) + & 1872 t_surf_h(m) 1873 ENDDO 1874 ELSE 1815 1875 DO m = 1, surf_usm_v(l)%ns 1816 1876 surf_usm_v(l)%t_surf_av(m) = & … … 1818 1878 t_surf_v(l)%t(m) 1819 1879 ENDDO 1820 END DO1880 ENDIF 1821 1881 1822 1882 CASE ( 'usm_t_surf_window' ) 1823 1883 !-- surface temperature for window surfaces 1824 DO m = 1, surf_usm_h%ns 1825 surf_usm_h%t_surf_window_av(m) = & 1826 surf_usm_h%t_surf_window_av(m) + & 1827 t_surf_window_h(m) 1828 ENDDO 1829 DO l = 0, 3 1884 IF ( l == -1 ) THEN 1885 DO m = 1, surf_usm_h%ns 1886 surf_usm_h%t_surf_window_av(m) = & 1887 surf_usm_h%t_surf_window_av(m) + & 1888 t_surf_window_h(m) 1889 ENDDO 1890 ELSE 1830 1891 DO m = 1, surf_usm_v(l)%ns 1831 1892 surf_usm_v(l)%t_surf_window_av(m) = & … … 1833 1894 t_surf_window_v(l)%t(m) 1834 1895 ENDDO 1835 END DO1896 ENDIF 1836 1897 1837 1898 CASE ( 'usm_t_surf_green' ) 1838 1899 !-- surface temperature for green surfaces 1839 DO m = 1, surf_usm_h%ns 1840 surf_usm_h%t_surf_green_av(m) = & 1841 surf_usm_h%t_surf_green_av(m) + & 1842 t_surf_green_h(m) 1843 ENDDO 1844 DO l = 0, 3 1900 IF ( l == -1 ) THEN 1901 DO m = 1, surf_usm_h%ns 1902 surf_usm_h%t_surf_green_av(m) = & 1903 surf_usm_h%t_surf_green_av(m) + & 1904 t_surf_green_h(m) 1905 ENDDO 1906 ELSE 1845 1907 DO m = 1, surf_usm_v(l)%ns 1846 1908 surf_usm_v(l)%t_surf_green_av(m) = & … … 1848 1910 t_surf_green_v(l)%t(m) 1849 1911 ENDDO 1850 END DO1912 ENDIF 1851 1913 1852 1914 CASE ( 'usm_t_surf_10cm' ) 1853 1915 !-- near surface temperature for whole surfaces 1854 DO m = 1, surf_usm_h%ns 1855 surf_usm_h%t_surf_10cm_av(m) = & 1856 surf_usm_h%t_surf_10cm_av(m) + & 1857 t_surf_10cm_h(m) 1858 ENDDO 1859 DO l = 0, 3 1916 IF ( l == -1 ) THEN 1917 DO m = 1, surf_usm_h%ns 1918 surf_usm_h%t_surf_10cm_av(m) = & 1919 surf_usm_h%t_surf_10cm_av(m) + & 1920 t_surf_10cm_h(m) 1921 ENDDO 1922 ELSE 1860 1923 DO m = 1, surf_usm_v(l)%ns 1861 1924 surf_usm_v(l)%t_surf_10cm_av(m) = & … … 1863 1926 t_surf_10cm_v(l)%t(m) 1864 1927 ENDDO 1865 END DO1928 ENDIF 1866 1929 1867 1930 1868 1931 CASE ( 'usm_t_wall' ) 1869 1932 !-- wall temperature for iwl layer of walls and land 1870 DO m = 1, surf_usm_h%ns 1871 surf_usm_h%t_wall_av(iwl,m) = & 1872 surf_usm_h%t_wall_av(iwl,m) + & 1873 t_wall_h(iwl,m) 1874 ENDDO 1875 DO l = 0, 3 1933 IF ( l == -1 ) THEN 1934 DO m = 1, surf_usm_h%ns 1935 surf_usm_h%t_wall_av(iwl,m) = & 1936 surf_usm_h%t_wall_av(iwl,m) + & 1937 t_wall_h(iwl,m) 1938 ENDDO 1939 ELSE 1876 1940 DO m = 1, surf_usm_v(l)%ns 1877 1941 surf_usm_v(l)%t_wall_av(iwl,m) = & … … 1879 1943 t_wall_v(l)%t(iwl,m) 1880 1944 ENDDO 1881 END DO1945 ENDIF 1882 1946 1883 1947 CASE ( 'usm_t_window' ) 1884 1948 !-- window temperature for iwl layer of walls and land 1885 DO m = 1, surf_usm_h%ns 1886 surf_usm_h%t_window_av(iwl,m) = & 1887 surf_usm_h%t_window_av(iwl,m) + & 1888 t_window_h(iwl,m) 1889 ENDDO 1890 DO l = 0, 3 1949 IF ( l == -1 ) THEN 1950 DO m = 1, surf_usm_h%ns 1951 surf_usm_h%t_window_av(iwl,m) = & 1952 surf_usm_h%t_window_av(iwl,m) + & 1953 t_window_h(iwl,m) 1954 ENDDO 1955 ELSE 1891 1956 DO m = 1, surf_usm_v(l)%ns 1892 1957 surf_usm_v(l)%t_window_av(iwl,m) = & … … 1894 1959 t_window_v(l)%t(iwl,m) 1895 1960 ENDDO 1896 END DO1961 ENDIF 1897 1962 1898 1963 CASE ( 'usm_t_green' ) 1899 1964 !-- green temperature for iwl layer of walls and land 1900 DO m = 1, surf_usm_h%ns 1901 surf_usm_h%t_green_av(iwl,m) = & 1902 surf_usm_h%t_green_av(iwl,m) + & 1903 t_green_h(iwl,m) 1904 ENDDO 1905 DO l = 0, 3 1965 IF ( l == -1 ) THEN 1966 DO m = 1, surf_usm_h%ns 1967 surf_usm_h%t_green_av(iwl,m) = & 1968 surf_usm_h%t_green_av(iwl,m) + & 1969 t_green_h(iwl,m) 1970 ENDDO 1971 ELSE 1906 1972 DO m = 1, surf_usm_v(l)%ns 1907 1973 surf_usm_v(l)%t_green_av(iwl,m) = & … … 1909 1975 t_green_v(l)%t(iwl,m) 1910 1976 ENDDO 1911 END DO1977 ENDIF 1912 1978 1913 1979 CASE DEFAULT … … 1922 1988 CASE ( 'usm_rad_net' ) 1923 1989 !-- array of complete radiation balance 1924 DO m = 1, surf_usm_h%ns 1925 surf_usm_h%rad_net_av(m) = & 1926 surf_usm_h%rad_net_av(m) / & 1927 REAL( average_count_3d, kind=wp ) 1928 ENDDO 1929 DO l = 0, 3 1990 IF ( l == -1 ) THEN 1991 DO m = 1, surf_usm_h%ns 1992 surf_usm_h%rad_net_av(m) = & 1993 surf_usm_h%rad_net_av(m) / & 1994 REAL( average_count_3d, kind=wp ) 1995 ENDDO 1996 ELSE 1930 1997 DO m = 1, surf_usm_v(l)%ns 1931 1998 surf_usm_v(l)%rad_net_av(m) = & … … 1933 2000 REAL( average_count_3d, kind=wp ) 1934 2001 ENDDO 1935 END DO2002 ENDIF 1936 2003 1937 2004 CASE ( 'usm_rad_insw' ) … … 2023 2090 ENDDO 2024 2091 2092 CASE ( 'usm_rad_pc_inlw' ) 2093 pcbinlw_av(:) = pcbinlw_av(:) / REAL( average_count_3d, kind=wp ) 2094 2095 CASE ( 'usm_rad_pc_insw' ) 2096 pcbinsw_av(:) = pcbinsw_av(:) / REAL( average_count_3d, kind=wp ) 2097 2098 CASE ( 'usm_rad_pc_inswdir' ) 2099 pcbinswdir_av(:) = pcbinswdir_av(:) / REAL( average_count_3d, kind=wp ) 2100 2101 CASE ( 'usm_rad_pc_inswdif' ) 2102 pcbinswdif_av(:) = pcbinswdif_av(:) / REAL( average_count_3d, kind=wp ) 2103 2104 CASE ( 'usm_rad_pc_inswref' ) 2105 pcbinswref_av(:) = pcbinswref_av(:) / REAL( average_count_3d, kind=wp ) 2106 2025 2107 CASE ( 'usm_rad_hf' ) 2026 2108 !-- array of heat flux from radiation for surfaces after i-th reflection 2027 DO m = 1, surf_usm_h%ns 2028 surf_usm_h%surfhf_av(m) = & 2029 surf_usm_h%surfhf_av(m) / & 2030 REAL( average_count_3d, kind=wp ) 2031 ENDDO 2032 DO l = 0, 3 2109 IF ( l == -1 ) THEN 2110 DO m = 1, surf_usm_h%ns 2111 surf_usm_h%surfhf_av(m) = & 2112 surf_usm_h%surfhf_av(m) / & 2113 REAL( average_count_3d, kind=wp ) 2114 ENDDO 2115 ELSE 2033 2116 DO m = 1, surf_usm_v(l)%ns 2034 2117 surf_usm_v(l)%surfhf_av(m) = & … … 2036 2119 REAL( average_count_3d, kind=wp ) 2037 2120 ENDDO 2038 END DO2121 ENDIF 2039 2122 2040 2123 CASE ( 'usm_wshf' ) 2041 2124 !-- array of sensible heat flux from surfaces (land, roof, wall) 2042 DO m = 1, surf_usm_h%ns 2043 surf_usm_h%wshf_eb_av(m) = & 2044 surf_usm_h%wshf_eb_av(m) / & 2045 REAL( average_count_3d, kind=wp ) 2046 ENDDO 2047 DO l = 0, 3 2125 IF ( l == -1 ) THEN 2126 DO m = 1, surf_usm_h%ns 2127 surf_usm_h%wshf_eb_av(m) = & 2128 surf_usm_h%wshf_eb_av(m) / & 2129 REAL( average_count_3d, kind=wp ) 2130 ENDDO 2131 ELSE 2048 2132 DO m = 1, surf_usm_v(l)%ns 2049 2133 surf_usm_v(l)%wshf_eb_av(m) = & … … 2051 2135 REAL( average_count_3d, kind=wp ) 2052 2136 ENDDO 2053 END DO2137 ENDIF 2054 2138 2055 2139 CASE ( 'usm_wghf' ) 2056 2140 !-- array of heat flux from ground (wall, roof, land) 2057 DO m = 1, surf_usm_h%ns 2058 surf_usm_h%wghf_eb_av(m) = & 2059 surf_usm_h%wghf_eb_av(m) / & 2060 REAL( average_count_3d, kind=wp ) 2061 ENDDO 2062 DO l = 0, 3 2141 IF ( l == -1 ) THEN 2142 DO m = 1, surf_usm_h%ns 2143 surf_usm_h%wghf_eb_av(m) = & 2144 surf_usm_h%wghf_eb_av(m) / & 2145 REAL( average_count_3d, kind=wp ) 2146 ENDDO 2147 ELSE 2063 2148 DO m = 1, surf_usm_v(l)%ns 2064 2149 surf_usm_v(l)%wghf_eb_av(m) = & … … 2066 2151 REAL( average_count_3d, kind=wp ) 2067 2152 ENDDO 2068 END DO2153 ENDIF 2069 2154 2070 2155 CASE ( 'usm_wghf_window' ) 2071 2156 !-- array of heat flux from window ground (wall, roof, land) 2072 DO m = 1, surf_usm_h%ns 2073 surf_usm_h%wghf_eb_window_av(m) = & 2074 surf_usm_h%wghf_eb_window_av(m) / & 2075 REAL( average_count_3d, kind=wp ) 2076 ENDDO 2077 DO l = 0, 3 2157 IF ( l == -1 ) THEN 2158 DO m = 1, surf_usm_h%ns 2159 surf_usm_h%wghf_eb_window_av(m) = & 2160 surf_usm_h%wghf_eb_window_av(m) / & 2161 REAL( average_count_3d, kind=wp ) 2162 ENDDO 2163 ELSE 2078 2164 DO m = 1, surf_usm_v(l)%ns 2079 2165 surf_usm_v(l)%wghf_eb_window_av(m) = & … … 2081 2167 REAL( average_count_3d, kind=wp ) 2082 2168 ENDDO 2083 END DO2169 ENDIF 2084 2170 2085 2171 CASE ( 'usm_wghf_green' ) 2086 2172 !-- array of heat flux from green ground (wall, roof, land) 2087 DO m = 1, surf_usm_h%ns 2088 surf_usm_h%wghf_eb_green_av(m) = & 2089 surf_usm_h%wghf_eb_green_av(m) / & 2090 REAL( average_count_3d, kind=wp ) 2091 ENDDO 2092 DO l = 0, 3 2173 IF ( l == -1 ) THEN 2174 DO m = 1, surf_usm_h%ns 2175 surf_usm_h%wghf_eb_green_av(m) = & 2176 surf_usm_h%wghf_eb_green_av(m) / & 2177 REAL( average_count_3d, kind=wp ) 2178 ENDDO 2179 ELSE 2093 2180 DO m = 1, surf_usm_v(l)%ns 2094 2181 surf_usm_v(l)%wghf_eb_green_av(m) = & … … 2096 2183 REAL( average_count_3d, kind=wp ) 2097 2184 ENDDO 2098 END DO2185 ENDIF 2099 2186 2100 2187 CASE ( 'usm_iwghf' ) 2101 2188 !-- array of heat flux from indoor ground (wall, roof, land) 2102 DO m = 1, surf_usm_h%ns 2103 surf_usm_h%iwghf_eb_av(m) = & 2104 surf_usm_h%iwghf_eb_av(m) / & 2105 REAL( average_count_3d, kind=wp ) 2106 ENDDO 2107 DO l = 0, 3 2189 IF ( l == -1 ) THEN 2190 DO m = 1, surf_usm_h%ns 2191 surf_usm_h%iwghf_eb_av(m) = & 2192 surf_usm_h%iwghf_eb_av(m) / & 2193 REAL( average_count_3d, kind=wp ) 2194 ENDDO 2195 ELSE 2108 2196 DO m = 1, surf_usm_v(l)%ns 2109 2197 surf_usm_v(l)%iwghf_eb_av(m) = & … … 2111 2199 REAL( average_count_3d, kind=wp ) 2112 2200 ENDDO 2113 END DO2201 ENDIF 2114 2202 2115 2203 CASE ( 'usm_iwghf_window' ) 2116 2204 !-- array of heat flux from indoor window ground (wall, roof, land) 2117 DO m = 1, surf_usm_h%ns 2118 surf_usm_h%iwghf_eb_window_av(m) = & 2119 surf_usm_h%iwghf_eb_window_av(m) / & 2120 REAL( average_count_3d, kind=wp ) 2121 ENDDO 2122 DO l = 0, 3 2205 IF ( l == -1 ) THEN 2206 DO m = 1, surf_usm_h%ns 2207 surf_usm_h%iwghf_eb_window_av(m) = & 2208 surf_usm_h%iwghf_eb_window_av(m) / & 2209 REAL( average_count_3d, kind=wp ) 2210 ENDDO 2211 ELSE 2123 2212 DO m = 1, surf_usm_v(l)%ns 2124 2213 surf_usm_v(l)%iwghf_eb_window_av(m) = & … … 2126 2215 REAL( average_count_3d, kind=wp ) 2127 2216 ENDDO 2128 END DO2217 ENDIF 2129 2218 2130 2219 CASE ( 'usm_t_surf' ) 2131 2220 !-- surface temperature for surfaces 2132 DO m = 1, surf_usm_h%ns 2133 surf_usm_h%t_surf_av(m) = & 2134 surf_usm_h%t_surf_av(m) / & 2135 REAL( average_count_3d, kind=wp ) 2136 ENDDO 2137 DO l = 0, 3 2221 IF ( l == -1 ) THEN 2222 DO m = 1, surf_usm_h%ns 2223 surf_usm_h%t_surf_av(m) = & 2224 surf_usm_h%t_surf_av(m) / & 2225 REAL( average_count_3d, kind=wp ) 2226 ENDDO 2227 ELSE 2138 2228 DO m = 1, surf_usm_v(l)%ns 2139 2229 surf_usm_v(l)%t_surf_av(m) = & … … 2141 2231 REAL( average_count_3d, kind=wp ) 2142 2232 ENDDO 2143 END DO2233 ENDIF 2144 2234 2145 2235 CASE ( 'usm_t_surf_window' ) 2146 2236 !-- surface temperature for window surfaces 2147 DO m = 1, surf_usm_h%ns 2148 surf_usm_h%t_surf_window_av(m) = & 2149 surf_usm_h%t_surf_window_av(m) / & 2150 REAL( average_count_3d, kind=wp ) 2151 ENDDO 2152 DO l = 0, 3 2237 IF ( l == -1 ) THEN 2238 DO m = 1, surf_usm_h%ns 2239 surf_usm_h%t_surf_window_av(m) = & 2240 surf_usm_h%t_surf_window_av(m) / & 2241 REAL( average_count_3d, kind=wp ) 2242 ENDDO 2243 ELSE 2153 2244 DO m = 1, surf_usm_v(l)%ns 2154 2245 surf_usm_v(l)%t_surf_window_av(m) = & … … 2156 2247 REAL( average_count_3d, kind=wp ) 2157 2248 ENDDO 2158 END DO2249 ENDIF 2159 2250 2160 2251 CASE ( 'usm_t_surf_green' ) 2161 2252 !-- surface temperature for green surfaces 2162 DO m = 1, surf_usm_h%ns 2163 surf_usm_h%t_surf_green_av(m) = & 2164 surf_usm_h%t_surf_green_av(m) / & 2165 REAL( average_count_3d, kind=wp ) 2166 ENDDO 2167 DO l = 0, 3 2253 IF ( l == -1 ) THEN 2254 DO m = 1, surf_usm_h%ns 2255 surf_usm_h%t_surf_green_av(m) = & 2256 surf_usm_h%t_surf_green_av(m) / & 2257 REAL( average_count_3d, kind=wp ) 2258 ENDDO 2259 ELSE 2168 2260 DO m = 1, surf_usm_v(l)%ns 2169 2261 surf_usm_v(l)%t_surf_green_av(m) = & … … 2171 2263 REAL( average_count_3d, kind=wp ) 2172 2264 ENDDO 2173 END DO2265 ENDIF 2174 2266 2175 2267 CASE ( 'usm_t_surf_10cm' ) 2176 2268 !-- near surface temperature for whole surfaces 2177 DO m = 1, surf_usm_h%ns 2178 surf_usm_h%t_surf_10cm_av(m) = & 2179 surf_usm_h%t_surf_10cm_av(m) / & 2180 REAL( average_count_3d, kind=wp ) 2181 ENDDO 2182 DO l = 0, 3 2269 IF ( l == -1 ) THEN 2270 DO m = 1, surf_usm_h%ns 2271 surf_usm_h%t_surf_10cm_av(m) = & 2272 surf_usm_h%t_surf_10cm_av(m) / & 2273 REAL( average_count_3d, kind=wp ) 2274 ENDDO 2275 ELSE 2183 2276 DO m = 1, surf_usm_v(l)%ns 2184 2277 surf_usm_v(l)%t_surf_10cm_av(m) = & … … 2186 2279 REAL( average_count_3d, kind=wp ) 2187 2280 ENDDO 2188 END DO2281 ENDIF 2189 2282 2190 2283 CASE ( 'usm_t_wall' ) 2191 2284 !-- wall temperature for iwl layer of walls and land 2192 DO m = 1, surf_usm_h%ns 2193 surf_usm_h%t_wall_av(iwl,m) = & 2194 surf_usm_h%t_wall_av(iwl,m) / & 2195 REAL( average_count_3d, kind=wp ) 2196 ENDDO 2197 DO l = 0, 3 2285 IF ( l == -1 ) THEN 2286 DO m = 1, surf_usm_h%ns 2287 surf_usm_h%t_wall_av(iwl,m) = & 2288 surf_usm_h%t_wall_av(iwl,m) / & 2289 REAL( average_count_3d, kind=wp ) 2290 ENDDO 2291 ELSE 2198 2292 DO m = 1, surf_usm_v(l)%ns 2199 2293 surf_usm_v(l)%t_wall_av(iwl,m) = & … … 2201 2295 REAL( average_count_3d, kind=wp ) 2202 2296 ENDDO 2203 END DO2297 ENDIF 2204 2298 2205 2299 CASE ( 'usm_t_window' ) 2206 2300 !-- window temperature for iwl layer of walls and land 2207 DO m = 1, surf_usm_h%ns 2208 surf_usm_h%t_window_av(iwl,m) = & 2209 surf_usm_h%t_window_av(iwl,m) / & 2210 REAL( average_count_3d, kind=wp ) 2211 ENDDO 2212 DO l = 0, 3 2301 IF ( l == -1 ) THEN 2302 DO m = 1, surf_usm_h%ns 2303 surf_usm_h%t_window_av(iwl,m) = & 2304 surf_usm_h%t_window_av(iwl,m) / & 2305 REAL( average_count_3d, kind=wp ) 2306 ENDDO 2307 ELSE 2213 2308 DO m = 1, surf_usm_v(l)%ns 2214 2309 surf_usm_v(l)%t_window_av(iwl,m) = & … … 2216 2311 REAL( average_count_3d, kind=wp ) 2217 2312 ENDDO 2218 END DO2313 ENDIF 2219 2314 2220 2315 CASE ( 'usm_t_green' ) 2221 2316 !-- green temperature for iwl layer of walls and land 2222 DO m = 1, surf_usm_h%ns 2223 surf_usm_h%t_green_av(iwl,m) = & 2224 surf_usm_h%t_green_av(iwl,m) / & 2225 REAL( average_count_3d, kind=wp ) 2226 ENDDO 2227 DO l = 0, 3 2317 IF ( l == -1 ) THEN 2318 DO m = 1, surf_usm_h%ns 2319 surf_usm_h%t_green_av(iwl,m) = & 2320 surf_usm_h%t_green_av(iwl,m) / & 2321 REAL( average_count_3d, kind=wp ) 2322 ENDDO 2323 ELSE 2228 2324 DO m = 1, surf_usm_v(l)%ns 2229 2325 surf_usm_v(l)%t_green_av(iwl,m) = & … … 2231 2327 REAL( average_count_3d, kind=wp ) 2232 2328 ENDDO 2233 END DO2329 ENDIF 2234 2330 2235 2331 … … 2309 2405 var(1:9) == 'usm_wshf_' .OR. var(1:9) == 'usm_wghf_' .OR. & 2310 2406 var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR. & 2311 var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_' ) THEN 2407 var(1:10) == 'usm_iwghf_' .OR. var(1:17) == 'usm_iwghf_window_' .OR. & 2408 var(1:17) == 'usm_surfwintrans_' ) THEN 2312 2409 unit = 'W/m2' 2313 ELSE IF ( var(1:10) == 'usm_t_surf' .OR. var(1:10) == 'usm_t_wall' .OR. 2410 ELSE IF ( var(1:10) == 'usm_t_surf' .OR. var(1:10) == 'usm_t_wall' .OR. & 2314 2411 var(1:12) == 'usm_t_window' .OR. var(1:17) == 'usm_t_surf_window' .OR. & 2315 2412 var(1:16) == 'usm_t_surf_green' .OR. & 2316 2413 var(1:11) == 'usm_t_green' .OR. & 2317 var(1:15) == 'usm_t_surf_10cm' ) THEN2414 var(1:15) == 'usm_t_surf_10cm' ) THEN 2318 2415 unit = 'K' 2416 ELSE IF ( var == 'usm_rad_pc_inlw' .OR. var == 'usm_rad_pc_insw' .OR. & 2417 var == 'usm_rad_pc_inswdir' .OR. var == 'usm_rad_pc_inswdif' .OR. & 2418 var == 'usm_rad_pc_inswref' ) THEN 2419 unit = 'W' 2319 2420 ELSE IF ( var(1:9) == 'usm_surfz' .OR. var(1:7) == 'usm_svf' .OR. & 2320 2421 var(1:7) == 'usm_dif' .OR. var(1:11) == 'usm_surfcat' .OR. & … … 2417 2518 INTEGER(iwp), DIMENSION(0:nd-1) :: dirstart 2418 2519 INTEGER(iwp), DIMENSION(0:nd-1) :: dirend 2419 INTEGER(iwp) :: ids,idsint,idsidx,isurf,isvf,isurfs,isurflt 2520 INTEGER(iwp) :: ids,idsint,idsidx,isurf,isvf,isurfs,isurflt,ipcgb 2420 2521 INTEGER(iwp) :: is,js,ks,i,j,k,iwl,istat, l, m 2421 2522 … … 2431 2532 k = len(TRIM(var)) 2432 2533 j = len(TRIM(dirname(i))) 2433 IF ( var(k-j+1:k) == dirname(i) ) THEN2534 IF ( TRIM(var(k-j+1:k)) == TRIM(dirname(i)) ) THEN 2434 2535 ids = i 2435 2536 idsint = dirint(ids) … … 2802 2903 ENDIF 2803 2904 ENDIF 2905 ENDDO 2906 2907 CASE ( 'usm_rad_pc_inlw' ) 2908 !-- array of lw radiation absorbed by plant canopy 2909 DO ipcgb = 1, npcbl 2910 IF ( av == 0 ) THEN 2911 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinlw(ipcgb) 2912 ELSE 2913 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinlw_av(ipcgb) 2914 ENDIF 2915 ENDDO 2916 2917 CASE ( 'usm_rad_pc_insw' ) 2918 !-- array of sw radiation absorbed by plant canopy 2919 DO ipcgb = 1, npcbl 2920 IF ( av == 0 ) THEN 2921 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinsw(ipcgb) 2922 ELSE 2923 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinsw_av(ipcgb) 2924 ENDIF 2925 ENDDO 2926 2927 CASE ( 'usm_rad_pc_inswdir' ) 2928 !-- array of direct sw radiation absorbed by plant canopy 2929 DO ipcgb = 1, npcbl 2930 IF ( av == 0 ) THEN 2931 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinswdir(ipcgb) 2932 ELSE 2933 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinswdir_av(ipcgb) 2934 ENDIF 2935 ENDDO 2936 2937 CASE ( 'usm_rad_pc_inswdif' ) 2938 !-- array of diffuse sw radiation absorbed by plant canopy 2939 DO ipcgb = 1, npcbl 2940 IF ( av == 0 ) THEN 2941 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinswdif(ipcgb) 2942 ELSE 2943 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinswdif_av(ipcgb) 2944 ENDIF 2945 ENDDO 2946 2947 CASE ( 'usm_rad_pc_inswref' ) 2948 !-- array of reflected sw radiation absorbed by plant canopy 2949 DO ipcgb = 1, npcbl 2950 IF ( av == 0 ) THEN 2951 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinsw(ipcgb) & 2952 - pcbinswdir(ipcgb) & 2953 - pcbinswdif(ipcgb) 2954 ELSE 2955 temp_pf(pcbl(iz,ipcgb),pcbl(iy,ipcgb),pcbl(ix,ipcgb)) = pcbinswref_av(ipcgb) 2956 ENDIF 2804 2957 ENDDO 2805 2958 … … 3356 3509 CASE DEFAULT 3357 3510 found = .FALSE. 3358 3511 RETURN 3359 3512 END SELECT 3360 3513 … … 3399 3552 var(1:14) == 'usm_rad_outsw_' .OR. var(1:14) == 'usm_rad_outlw_' .OR. & 3400 3553 var(1:14) == 'usm_rad_ressw_' .OR. var(1:14) == 'usm_rad_reslw_' .OR. & 3401 var(1:11) == 'usm_rad_hf_' .OR. & 3554 var(1:11) == 'usm_rad_hf_' .OR. var == 'usm_rad_pc_inlw' .OR. & 3555 var == 'usm_rad_pc_insw' .OR. var == 'usm_rad_pc_inswdir' .OR. & 3556 var == 'usm_rad_pc_inswdif' .OR. var == 'usm_rad_pc_inswref' .OR. & 3402 3557 var(1:9) == 'usm_wshf_' .OR. var(1:9) == 'usm_wghf_' .OR. & 3403 3558 var(1:16) == 'usm_wghf_window_' .OR. var(1:15) == 'usm_wghf_green_' .OR. & … … 4965 5120 * wintend(nzb_wall:nzt_wall) + tsc(3) & 4966 5121 * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) ) 4967 5122 4968 5123 ! 4969 5124 !-- calculate t_wall tendencies for the next Runge-Kutta step … … 5168 5323 ENDIF 5169 5324 ENDDO 5325 !!!!!!!!!!!!!HACK!!!!!!!!!!!!!!!!!!! 5326 ! t_window_v_p(l)%t = t_wall_v_p(l)%t 5327 ! surf_usm_v(l)%tt_window_m = surf_usm_v(l)%tt_wall_m 5328 ! t_green_v_p(l)%t = t_wall_v_p(l)%t 5329 ! surf_usm_v(l)%tt_green_m = surf_usm_v(l)%tt_wall_m 5330 !!!!!!!!!!!!!HACK!!!!!!!!!!!!!!!!!!! 5170 5331 ENDDO 5171 5332 … … 5320 5481 naheatlayers, & 5321 5482 pedestrian_category, & 5483 roughness_concrete, & 5322 5484 read_wall_temp_3d, & 5323 5485 roof_category, & … … 5337 5499 naheatlayers, & 5338 5500 pedestrian_category, & 5501 roughness_concrete, & 5339 5502 read_wall_temp_3d, & 5340 5503 roof_category, & … … 6937 7100 ENDDO 6938 7101 IF ( ip == -99999 ) THEN 6939 !-- wall category not found 6940 WRITE (message_string, "(A,I5,A,3I5)") 'wall category ', it, & 6941 ' not found for i,j,k=', iw,jw,kw 6942 CALL message( 'usm_read_urban_surface', 'PA0506', 1, 2, 0, 6, 0 ) 7102 !-- land/roof category not found 7103 WRITE (9,"(A,I5,A,3I5)") 'land/roof category ', it, & 7104 ' not found for i,j,k=', iw,jw,kw 7105 FLUSH(9) 7106 IF ( surf_usm_h%isroof_surf(m) ) THEN 7107 category = roof_category 7108 ELSE 7109 category = land_category 7110 ENDIF 7111 DO k = 1, n_surface_types 7112 IF ( surface_type_codes(k) == roof_category ) THEN 7113 ip = k 7114 EXIT 7115 ENDIF 7116 ENDDO 7117 IF ( ip == -99999 ) THEN 7118 !-- default land/roof category not found 7119 WRITE (9,"(A,I5,A,3I5)") 'Default land/roof category', category, ' not found!' 7120 FLUSH(9) 7121 ip = 1 7122 ENDIF 6943 7123 ENDIF 6944 7124 ! … … 7036 7216 surf_usm_v(l)%albedo(:,m) = -1.0_wp 7037 7217 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7218 surf_usm_v(l)%thickness_window(m) = -1.0_wp 7219 surf_usm_v(l)%thickness_green(m) = -1.0_wp 7220 surf_usm_v(l)%transmissivity(m) = -1.0_wp 7038 7221 ELSE IF ( kw <= usm_par(ii,jw,iw) ) THEN 7039 7222 !-- pedestrian zone … … 7089 7272 ELSE 7090 7273 ! 7274 WRITE(9,*) 'Problem reading USM data:' 7275 WRITE(9,*) l,i,j,kw,get_topography_top_index_ji( j, i, 's' ) 7276 WRITE(9,*) ii,iw,jw,kw,get_topography_top_index_ji( jw, iw, 's' ) 7277 WRITE(9,*) usm_par(ii,jw,iw),usm_par(ii+1,jw,iw) 7278 WRITE(9,*) usm_par(ii+2,jw,iw),usm_par(ii+3,jw,iw) 7279 WRITE(9,*) usm_par(ii+4,jw,iw),usm_par(ii+5,jw,iw) 7280 WRITE(9,*) kw,roof_height_limit,wall_category,roof_category 7281 FLUSH(9) 7091 7282 !-- supply the default category 7092 7283 IF ( kw <= roof_height_limit ) THEN … … 7097 7288 surf_usm_v(l)%albedo(:,m) = -1.0_wp 7098 7289 surf_usm_v(l)%thickness_wall(m) = -1.0_wp 7290 surf_usm_v(l)%thickness_window(m) = -1.0_wp 7291 surf_usm_v(l)%thickness_green(m) = -1.0_wp 7292 surf_usm_v(l)%transmissivity(m) = -1.0_wp 7099 7293 ENDIF 7100 7294 ! … … 7110 7304 IF ( ip == -99999 ) THEN 7111 7305 !-- wall category not found 7112 WRITE (message_string, "(A,I7,A,3I5)") 'wall category ', it, & 7113 ' not found for i,j,k=', iw,jw,kw 7114 WRITE(9,*) message_string 7306 WRITE (9, "(A,I7,A,3I5)") 'wall category ', it, & 7307 ' not found for i,j,k=', iw,jw,kw 7308 FLUSH(9) 7309 category = wall_category 7310 DO k = 1, n_surface_types 7311 IF ( surface_type_codes(k) == category ) THEN 7312 ip = k 7313 EXIT 7314 ENDIF 7315 ENDDO 7316 IF ( ip == -99999 ) THEN 7317 !-- default wall category not found 7318 WRITE (9, "(A,I5,A,3I5)") 'Default wall category', category, ' not found!' 7319 FLUSH(9) 7320 ip = 1 7321 ENDIF 7115 7322 ENDIF 7323 7116 7324 ! 7117 7325 !-- Albedo … … 7192 7400 ENDDO 7193 7401 7402 7403 WRITE(9,*) 'Urban surfaces read' 7404 FLUSH(9) 7405 7194 7406 CALL location_message( ' types and parameters of urban surfaces read', .TRUE. ) 7195 7407 … … 7473 7685 IF ( humidity ) surf_usm_h%vpt_surface(m) = & 7474 7686 surf_usm_h%pt_surface(m) 7475 7687 7476 7688 !-- calculate true tendency 7477 7689 stend = ( t_surf_h_p(m) - t_surf_h(m) - dt_3d * tsc(3) * & … … 7508 7720 ! 7509 7721 !-- calculate fluxes 7510 !-- rad_net_l is never used! 7722 !-- rad_net_l is never used! 7511 7723 surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) + & 7512 7724 surf_usm_h%frac(ind_veg_wall,m) * & … … 7522 7734 surf_usm_h%wghf_eb(m) = lambda_surface * & 7523 7735 ( t_surf_h_p(m) - t_wall_h(nzb_wall,m) ) 7524 surf_usm_h%wghf_eb_green(m) = lambda_surface_green * &7736 surf_usm_h%wghf_eb_green(m) = lambda_surface_green * & 7525 7737 ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) ) 7526 surf_usm_h%wghf_eb_window(m) = lambda_surface_window * &7738 surf_usm_h%wghf_eb_window(m) = lambda_surface_window * & 7527 7739 ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) ) 7528 7740 … … 7539 7751 !-- diffusion_s, surface_layer_fluxes,... 7540 7752 surf_usm_h%shf(m) = surf_usm_h%wshf_eb(m) / c_p 7541 7753 7542 7754 ENDDO 7543 7755 ! … … 7562 7774 #if ! defined( __nopointer ) 7563 7775 ! 7564 !-- calculate rho * c_p coefficient at surfacelayer7776 !-- calculate rho * c_p coefficient at wall layer 7565 7777 rho_cp = c_p * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exner(k) ) 7566 7778 #endif … … 7589 7801 !-- obtained by simple linear interpolation. ( An alternative would 7590 7802 !-- be an logarithmic interpolation. ) 7591 !-- A roughness lenght of 0.001 is assumed for concrete (the inverse,7592 !-- 1000 is used in the nominator for scaling)7593 surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) * 1000.0_wp&7594 * ( 11.8_wp + 4.2_wp *&7803 !-- Parameter roughness_concrete (default value = 0.001) is used 7804 !-- to calculation of roughness relative to concrete 7805 surf_usm_v(l)%r_a(m) = rho_cp / ( surf_usm_v(l)%z0(m) / & 7806 roughness_concrete * ( 11.8_wp + 4.2_wp * & 7595 7807 SQRT( MAX( ( ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp )**2 + & 7596 7808 ( ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp )**2 + & … … 7606 7818 f_shf_window = rho_cp / surf_usm_v(l)%r_a(m) 7607 7819 f_shf_green = rho_cp / surf_usm_v(l)%r_a(m) 7608 7609 7610 7820 7611 7821 !-- add LW up so that it can be removed in prognostic equation … … 7657 7867 ( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 7658 7868 7659 7660 7661 7869 !-- add RK3 term 7662 7870 t_surf_v_p(l)%t(m) = t_surf_v_p(l)%t(m) + dt_3d * tsc(3) * & … … 7677 7885 IF ( humidity ) surf_usm_v(l)%vpt_surface(m) = & 7678 7886 surf_usm_v(l)%pt_surface(m) 7679 7887 7680 7888 !-- calculate true tendency 7681 7889 stend = ( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) - dt_3d * tsc(3) *& … … 7766 7974 dtime = mod(simulated_time + time_utc_init, 24.0_wp*3600.0_wp) 7767 7975 dhour = INT(dtime/3600.0_wp) 7768 DO m = 1, naheatlayers 7769 !-- Get indices of respective grid point 7770 i = surf_usm_h%i(m) 7771 j = surf_usm_h%j(m) 7772 k = surf_usm_h%k(m) 7773 IF ( k > get_topography_top_index_ji( j, i, 's' ) .AND. & 7774 k <= naheatlayers ) THEN 7775 !-- increase of pt in box i,j,k in time dt_3d 7776 !-- given to anthropogenic heat aheat*acoef (W*m-2) 7777 !-- linear interpolation of coeficient 7778 acoef = (REAL(dhour+1,wp)-dtime/3600.0_wp)*aheatprof(k,dhour) + & 7779 (dtime/3600.0_wp-REAL(dhour,wp))*aheatprof(k,dhour+1) 7780 IF ( aheat(k,j,i) > 0.0_wp ) THEN 7781 pt(k,j,i) = pt(k,j,i) + aheat(k,j,i)*acoef*dt_3d/(exner(k)*rho_cp*dzu(k)) 7782 ENDIF 7783 ENDIF 7976 DO i = nxl, nxr 7977 DO j = nys, nyn 7978 DO k = nzub, min(nzut,naheatlayers) 7979 IF ( k > get_topography_top_index_ji( j, i, 's' ) ) THEN 7980 !-- increase of pt in box i,j,k in time dt_3d 7981 !-- given to anthropogenic heat aheat*acoef (W*m-2) 7982 !-- linear interpolation of coeficient 7983 acoef = (REAL(dhour+1,wp)-dtime/3600.0_wp)*aheatprof(k,dhour) + & 7984 (dtime/3600.0_wp-REAL(dhour,wp))*aheatprof(k,dhour+1) 7985 IF ( aheat(k,j,i) > 0.0_wp ) THEN 7986 !-- calculate rho * c_p coefficient at layer k 7987 rho_cp = c_p * hyp(k) / ( r_d * pt(k+1,j,i) * exner(k) ) 7988 pt(k,j,i) = pt(k,j,i) + aheat(k,j,i)*acoef*dt_3d/(exner(k)*rho_cp*dz(1)) 7989 ENDIF 7990 ENDIF 7991 ENDDO 7992 ENDDO 7784 7993 ENDDO 7785 7994
Note: See TracChangeset
for help on using the changeset viewer.