Changeset 2963 for palm/trunk/SOURCE/radiation_model_mod.f90
- Timestamp:
- Apr 12, 2018 2:47:44 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/radiation_model_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/radiation_model_mod.f90
r2944 r2963 28 28 ! ----------------- 29 29 ! $Id$ 30 ! - Introduce index for vegetation/wall, pavement/green-wall and water/window 31 ! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. . 32 ! - Minor bugfix in initialization of albedo for window surfaces 33 ! 34 ! 2944 2018-04-03 16:20:18Z suehring 30 35 ! Fixed bad commit 31 36 ! … … 361 366 USE surface_mod, & 362 367 ONLY: get_topography_top_index, get_topography_top_index_ji, & 368 ind_pav_green, ind_veg_wall, ind_wat_win, & 363 369 surf_lsm_h, surf_lsm_v, surf_type, surf_usm_h, surf_usm_v 364 370 … … 1524 1530 !-- Only if albedo_type is non-zero 1525 1531 DO m = 1, surf_lsm_h%ns 1526 IF ( surf_lsm_h%albedo_type( 0,m) /= 0 )&1527 surf_lsm_h%albedo( 0,m) =&1528 albedo_pars(2,surf_lsm_h%albedo_type(0,m))1529 IF ( surf_lsm_h%albedo_type( 1,m) /= 0 )&1530 surf_lsm_h%albedo( 1,m) =&1531 albedo_pars(2,surf_lsm_h%albedo_type(1,m))1532 IF ( surf_lsm_h%albedo_type( 2,m) /= 0 )&1533 surf_lsm_h%albedo( 2,m) =&1534 albedo_pars(2,surf_lsm_h%albedo_type(2,m))1532 IF ( surf_lsm_h%albedo_type(ind_veg_wall,m) /= 0 ) & 1533 surf_lsm_h%albedo(ind_veg_wall,m) = & 1534 albedo_pars(2,surf_lsm_h%albedo_type(ind_veg_wall,m)) 1535 IF ( surf_lsm_h%albedo_type(ind_pav_green,m) /= 0 ) & 1536 surf_lsm_h%albedo(ind_pav_green,m) = & 1537 albedo_pars(2,surf_lsm_h%albedo_type(ind_pav_green,m)) 1538 IF ( surf_lsm_h%albedo_type(ind_wat_win,m) /= 0 ) & 1539 surf_lsm_h%albedo(ind_wat_win,m) = & 1540 albedo_pars(2,surf_lsm_h%albedo_type(ind_wat_win,m)) 1535 1541 ENDDO 1536 1542 DO m = 1, surf_usm_h%ns 1537 IF ( surf_usm_h%albedo_type( 0,m) /= 0 )&1538 surf_usm_h%albedo( 0,m) =&1539 albedo_pars(2,surf_usm_h%albedo_type(0,m))1540 IF ( surf_usm_h%albedo_type( 1,m) /= 0 )&1541 surf_usm_h%albedo( 1,m) =&1542 albedo_pars(2,surf_usm_h%albedo_type(1,m))1543 IF ( surf_usm_h%albedo_type( 2,m) /= 0 )&1544 surf_usm_h%albedo( 2,m) =&1545 albedo_pars(2,surf_usm_h%albedo_type(2,m))1543 IF ( surf_usm_h%albedo_type(ind_veg_wall,m) /= 0 ) & 1544 surf_usm_h%albedo(ind_veg_wall,m) = & 1545 albedo_pars(2,surf_usm_h%albedo_type(ind_veg_wall,m)) 1546 IF ( surf_usm_h%albedo_type(ind_pav_green,m) /= 0 ) & 1547 surf_usm_h%albedo(ind_pav_green,m) = & 1548 albedo_pars(2,surf_usm_h%albedo_type(ind_pav_green,m)) 1549 IF ( surf_usm_h%albedo_type(ind_wat_win,m) /= 0 ) & 1550 surf_usm_h%albedo(ind_wat_win,m) = & 1551 albedo_pars(2,surf_usm_h%albedo_type(ind_wat_win,m)) 1546 1552 ENDDO 1547 1553 1548 1554 DO l = 0, 3 1549 1555 DO m = 1, surf_lsm_v(l)%ns 1550 IF ( surf_lsm_v(l)%albedo_type( 0,m) /= 0 )&1551 surf_lsm_v(l)%albedo( 0,m) =&1552 albedo_pars(2,surf_lsm_v(l)%albedo_type(0,m))1553 IF ( surf_lsm_v(l)%albedo_type( 1,m) /= 0 )&1554 surf_lsm_v(l)%albedo( 1,m) =&1555 albedo_pars(2,surf_lsm_v(l)%albedo_type(1,m))1556 IF ( surf_lsm_v(l)%albedo_type( 2,m) /= 0 )&1557 surf_lsm_v(l)%albedo( 2,m) =&1558 albedo_pars(2,surf_lsm_v(l)%albedo_type(2,m))1556 IF ( surf_lsm_v(l)%albedo_type(ind_veg_wall,m) /= 0 ) & 1557 surf_lsm_v(l)%albedo(ind_veg_wall,m) = & 1558 albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_veg_wall,m)) 1559 IF ( surf_lsm_v(l)%albedo_type(ind_pav_green,m) /= 0 ) & 1560 surf_lsm_v(l)%albedo(ind_pav_green,m) = & 1561 albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_pav_green,m)) 1562 IF ( surf_lsm_v(l)%albedo_type(ind_wat_win,m) /= 0 ) & 1563 surf_lsm_v(l)%albedo(ind_wat_win,m) = & 1564 albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_wat_win,m)) 1559 1565 ENDDO 1560 1566 DO m = 1, surf_usm_v(l)%ns 1561 IF ( surf_usm_v(l)%albedo_type( 0,m) /= 0 )&1562 surf_usm_v(l)%albedo( 0,m) =&1563 albedo_pars(2,surf_usm_v(l)%albedo_type(0,m))1564 IF ( surf_usm_v(l)%albedo_type( 1,m) /= 0 )&1565 surf_usm_v(l)%albedo( 1,m) =&1566 albedo_pars(2,surf_usm_v(l)%albedo_type(1,m))1567 IF ( surf_usm_v(l)%albedo_type( 2,m) /= 0 )&1568 surf_usm_v(l)%albedo( 2,m) =&1569 albedo_pars(2,surf_usm_v(l)%albedo_type(2,m))1567 IF ( surf_usm_v(l)%albedo_type(ind_veg_wall,m) /= 0 ) & 1568 surf_usm_v(l)%albedo(ind_veg_wall,m) = & 1569 albedo_pars(2,surf_usm_v(l)%albedo_type(ind_veg_wall,m)) 1570 IF ( surf_usm_v(l)%albedo_type(ind_pav_green,m) /= 0 ) & 1571 surf_usm_v(l)%albedo(ind_pav_green,m) = & 1572 albedo_pars(2,surf_usm_v(l)%albedo_type(ind_pav_green,m)) 1573 IF ( surf_usm_v(l)%albedo_type(ind_wat_win,m) /= 0 ) & 1574 surf_usm_v(l)%albedo(ind_wat_win,m) = & 1575 albedo_pars(2,surf_usm_v(l)%albedo_type(ind_wat_win,m)) 1570 1576 ENDDO 1571 1577 ENDDO … … 1582 1588 j = surf_lsm_h%j(m) 1583 1589 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1584 IF ( surf_lsm_h%albedo_type( 0,m) == 0 )&1585 surf_lsm_h%albedo( 0,m) = albedo_pars_f%pars_xy(0,j,i)1586 IF ( surf_lsm_h%albedo_type( 1,m) == 0 )&1587 surf_lsm_h%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1588 IF ( surf_lsm_h%albedo_type( 2,m) == 0 )&1589 surf_lsm_h%albedo( 2,m) = albedo_pars_f%pars_xy(0,j,i)1590 IF ( surf_lsm_h%albedo_type(ind_veg_wall,m) == 0 ) & 1591 surf_lsm_h%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i) 1592 IF ( surf_lsm_h%albedo_type(ind_pav_green,m) == 0 ) & 1593 surf_lsm_h%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i) 1594 IF ( surf_lsm_h%albedo_type(ind_wat_win,m) == 0 ) & 1595 surf_lsm_h%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i) 1590 1596 ENDIF 1591 1597 ENDDO … … 1594 1600 j = surf_usm_h%j(m) 1595 1601 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1596 IF ( surf_usm_h%albedo_type( 0,m) == 0 )&1597 surf_usm_h%albedo( 0,m) = albedo_pars_f%pars_xy(0,j,i)1598 IF ( surf_usm_h%albedo_type( 1,m) == 0 )&1599 surf_usm_h%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1600 IF ( surf_usm_h%albedo_type( 2,m) == 0 )&1601 surf_usm_h%albedo( 2,m) = albedo_pars_f%pars_xy(0,j,i)1602 IF ( surf_usm_h%albedo_type(ind_veg_wall,m) == 0 ) & 1603 surf_usm_h%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i) 1604 IF ( surf_usm_h%albedo_type(ind_pav_green,m) == 0 ) & 1605 surf_usm_h%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i) 1606 IF ( surf_usm_h%albedo_type(ind_wat_win,m) == 0 ) & 1607 surf_usm_h%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i) 1602 1608 ENDIF 1603 1609 ENDDO … … 1612 1618 j = surf_lsm_v(l)%j(m) + joff 1613 1619 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1614 IF ( surf_lsm_v(l)%albedo_type( 0,m) == 0 )&1615 surf_lsm_v(l)%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1616 IF ( surf_lsm_v(l)%albedo_type( 1,m) == 0 )&1617 surf_lsm_v(l)%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1618 IF ( surf_lsm_v(l)%albedo_type( 2,m) == 0 )&1619 surf_lsm_v(l)%albedo( 2,m) = albedo_pars_f%pars_xy(0,j,i)1620 IF ( surf_lsm_v(l)%albedo_type(ind_veg_wall,m) == 0 ) & 1621 surf_lsm_v(l)%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i) 1622 IF ( surf_lsm_v(l)%albedo_type(ind_pav_green,m) == 0 ) & 1623 surf_lsm_v(l)%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i) 1624 IF ( surf_lsm_v(l)%albedo_type(ind_wat_win,m) == 0 ) & 1625 surf_lsm_v(l)%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i) 1620 1626 ENDIF 1621 1627 ENDDO … … 1627 1633 j = surf_usm_h%j(m) + joff 1628 1634 IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill ) THEN 1629 IF ( surf_usm_v(l)%albedo_type( 0,m) == 0 )&1630 surf_usm_v(l)%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1631 IF ( surf_usm_v(l)%albedo_type( 1,m) == 0 )&1632 surf_usm_v(l)%albedo( 1,m) = albedo_pars_f%pars_xy(0,j,i)1633 IF ( surf_usm_v(l)%albedo_type( 2,m) == 0 )&1634 surf_lsm_v(l)%albedo( 2,m) = albedo_pars_f%pars_xy(0,j,i)1635 IF ( surf_usm_v(l)%albedo_type(ind_veg_wall,m) == 0 ) & 1636 surf_usm_v(l)%albedo(ind_veg_wall,m) = albedo_pars_f%pars_xy(0,j,i) 1637 IF ( surf_usm_v(l)%albedo_type(ind_pav_green,m) == 0 ) & 1638 surf_usm_v(l)%albedo(ind_pav_green,m) = albedo_pars_f%pars_xy(0,j,i) 1639 IF ( surf_usm_v(l)%albedo_type(ind_wat_win,m) == 0 ) & 1640 surf_lsm_v(l)%albedo(ind_wat_win,m) = albedo_pars_f%pars_xy(0,j,i) 1635 1641 ENDIF 1636 1642 ENDDO … … 2288 2294 !-- calculated fluxes below are not actually used as they are 2289 2295 !-- overwritten in radiation_interaction. 2290 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2291 + surf%frac(1,m) * surf%albedo(1,m) & 2292 + surf%frac(2,m) * surf%albedo(2,m) ) & 2296 surf%rad_sw_out(m) = ( surf%frac(ind_veg_wall,m) * & 2297 surf%albedo(ind_veg_wall,m) & 2298 + surf%frac(ind_pav_green,m) * & 2299 surf%albedo(ind_pav_green,m) & 2300 + surf%frac(ind_wat_win,m) * & 2301 surf%albedo(ind_wat_win,m) ) & 2293 2302 * surf%rad_sw_in(m) 2294 2303 2295 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2296 + surf%frac(1,m) * surf%emissivity(1,m)& 2297 + surf%frac(2,m) * surf%emissivity(2,m)& 2304 surf%rad_lw_out(m) = ( surf%frac(ind_veg_wall,m) * & 2305 surf%emissivity(ind_veg_wall,m) & 2306 + surf%frac(ind_pav_green,m) * & 2307 surf%emissivity(ind_pav_green,m) & 2308 + surf%frac(ind_wat_win,m) * & 2309 surf%emissivity(ind_wat_win,m) & 2298 2310 ) & 2299 2311 * sigma_sb & … … 2301 2313 2302 2314 surf%rad_lw_out_change_0(m) = & 2303 ( surf%frac(0,m) * surf%emissivity(0,m) & 2304 + surf%frac(1,m) * surf%emissivity(1,m) & 2305 + surf%frac(2,m) * surf%emissivity(2,m) & 2315 ( surf%frac(ind_veg_wall,m) * & 2316 surf%emissivity(ind_veg_wall,m) & 2317 + surf%frac(ind_pav_green,m) * & 2318 surf%emissivity(ind_pav_green,m) & 2319 + surf%frac(ind_wat_win,m) * & 2320 surf%emissivity(ind_wat_win,m) & 2306 2321 ) * 3.0_wp * sigma_sb & 2307 2322 * ( surf%pt_surface(m) * exn )** 3 … … 2474 2489 ! 2475 2490 !-- Weighted average according to surface fraction. 2476 surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)& 2477 + surf%frac(1,m) * surf%emissivity(1,m)& 2478 + surf%frac(2,m) * surf%emissivity(2,m)& 2491 surf%rad_lw_out(m) = ( surf%frac(ind_veg_wall,m) * & 2492 surf%emissivity(ind_veg_wall,m) & 2493 + surf%frac(ind_pav_green,m) * & 2494 surf%emissivity(ind_pav_green,m) & 2495 + surf%frac(ind_wat_win,m) * & 2496 surf%emissivity(ind_wat_win,m) & 2479 2497 ) & 2480 2498 * sigma_sb & … … 2484 2502 + surf%rad_lw_out(m) ) & 2485 2503 / ( 1.0_wp - & 2486 ( surf%frac(0,m) * surf%albedo(0,m) +& 2487 surf%frac(1,m) * surf%albedo(1,m) +& 2488 surf%frac(1,m) * surf%albedo(1,m) )& 2504 ( surf%frac(ind_veg_wall,m) * & 2505 surf%albedo(ind_veg_wall,m) & 2506 + surf%frac(ind_pav_green,m) * & 2507 surf%albedo(ind_pav_green,m) & 2508 + surf%frac(ind_wat_win,m) * & 2509 surf%albedo(ind_wat_win,m) ) & 2489 2510 ) 2490 2511 2491 surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) & 2492 + surf%frac(1,m) * surf%albedo(1,m) & 2493 + surf%frac(2,m) * surf%albedo(2,m) ) & 2512 surf%rad_sw_out(m) = ( surf%frac(ind_veg_wall,m) * & 2513 surf%albedo(ind_veg_wall,m) & 2514 + surf%frac(ind_pav_green,m) * & 2515 surf%albedo(ind_pav_green,m) & 2516 + surf%frac(ind_wat_win,m) * & 2517 surf%albedo(ind_wat_win,m) ) & 2494 2518 * surf%rad_sw_in(m) 2495 2519 … … 3099 3123 !-- surfaces. 3100 3124 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 3101 rrtm_emis = surf_lsm_h%frac(0,m) * surf_lsm_h%emissivity(0,m) +& 3102 surf_lsm_h%frac(1,m) * surf_lsm_h%emissivity(1,m) +& 3103 surf_lsm_h%frac(2,m) * surf_lsm_h%emissivity(2,m) 3104 rrtm_tsfc = pt(surf_lsm_h%k(m)+surf_lsm_h%koff,j,i) * & 3125 rrtm_emis = surf_lsm_h%frac(ind_veg_wall,m) * & 3126 surf_lsm_h%emissivity(ind_veg_wall,m) + & 3127 surf_lsm_h%frac(ind_pav_green,m) * & 3128 surf_lsm_h%emissivity(ind_pav_green,m) + & 3129 surf_lsm_h%frac(ind_wat_win,m) * & 3130 surf_lsm_h%emissivity(ind_wat_win,m) 3131 rrtm_tsfc = pt(surf_lsm_h%k(m)+surf_lsm_h%koff,j,i) * & 3105 3132 (surface_pressure / 1000.0_wp )**0.286_wp 3106 3133 ENDDO 3107 3134 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 3108 rrtm_emis = surf_usm_h%frac(0,m) * surf_usm_h%emissivity(0,m) +& 3109 surf_usm_h%frac(1,m) * surf_usm_h%emissivity(1,m) +& 3110 surf_usm_h%frac(2,m) * surf_usm_h%emissivity(2,m) 3111 rrtm_tsfc = pt(surf_usm_h%k(m)+surf_usm_h%koff,j,i) * & 3135 rrtm_emis = surf_usm_h%frac(ind_veg_wall,m) * & 3136 surf_usm_h%emissivity(ind_veg_wall,m) + & 3137 surf_usm_h%frac(ind_pav_green,m) * & 3138 surf_usm_h%emissivity(ind_pav_green,m) + & 3139 surf_usm_h%frac(ind_wat_win,m) * & 3140 surf_usm_h%emissivity(ind_wat_win,m) 3141 rrtm_tsfc = pt(surf_usm_h%k(m)+surf_usm_h%koff,j,i) * & 3112 3142 (surface_pressure / 1000.0_wp )**0.286_wp 3113 3143 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
